home *** CD-ROM | disk | FTP | other *** search
/ BBS Toolkit / BBS Toolkit.iso / rbbs_pc / rbbsbas.zip / RBBSSUB3.BAS < prev    next >
BASIC Source File  |  1988-10-02  |  117KB  |  3,238 lines
  1. ' $linesize:132
  2. ' $title: 'RBBSSUB3.BAS CPC17-1A  Copyright 1986 - 88 by D. Thomas Mack'
  3. '  Copyright 1987 by D. Thomas Mack, all rights reserved.
  4. '  Name ...............: RBBSSUB3.BAS
  5. '  Written by .........: D. Thomas Mack
  6. '  First Released .....: September 18, 1988
  7. '  Subsequent Releases.:
  8. '  Copyright ..........: 1986, 1987, 1988
  9. '  Purpose.............: The Remote Bulletin Board System for the IBM PC,
  10. '                        RBBS-PC.BAS utilizes a lot of common subroutines.
  11. '                        Those that do not require error trapping are
  12. '                        incorporated within RBBSSUB2.BAS, RBBSSUB3.BAS,
  13. '                        RBBSSUB4.BAS and RBBSSUB5.BAS as separately
  14. '                        callable subroutines in order to free up as much
  15. '                        code as possible within the 64K code segment
  16. '                        used by RBBS-PC.BAS.
  17. '  Parameters..........: Most parameters are passed via a COMMON statement.
  18. '
  19. ' Subroutine  Line               Function of Subroutine
  20. '   Name     Number
  21. '  ALLCAPS    58060   Convert a string to all upper case characters
  22. '  AMORPM     41500   Calculate the current time as AM or PM
  23. '  ASKGRAPH   43306   Determine users graphic default
  24. '  BADFILE    20741   Check for system crash attempt with bad device name
  25. '  CALLOPT    58090   Set prompts based on the user's security
  26. '  CARRIER    42000   Test for Carrier present
  27. '  CHECKRATIO 20096   Test upload/download ratio
  28. '  CHECKTIM   58070   Test to insure that users don't exceed their time
  29. '  CHKNEWBUL  58110   Check for new bulletins based on their file creation date
  30. '  CHKTREMAIN 41008   Set up to log off if time exceeded
  31. '  COMMINFO   44000+  Get users baud rate and parity in a string format
  32. '  CTLINES    58160   Count categories a file can be classified into
  33. '  CTNEWFILES 58150   Check for number of files uploaded after a specific date
  34. '  DELAYIT    50500   Wait number of seconds specified before returning
  35. '  DISPCALL   57001   Display callers file
  36. '  DISPLAYTR  41010+  Compute and display time remaining
  37. '  DISUPDIR   58165   Display the shared directory of the FMS mng. sys.
  38. '  FILELOCK   21995   Allow files to be shared among multiple RBBS-PC's
  39. '  FINDFUNC   30600   Handle local keyboard's function & SYSOP's keys
  40. '  FINDLAST   58600   Finds last occurence of a string in a string
  41. '  FINDTIME   58050   Calculate the number of seconds since midnight
  42. '  GRAPHIC    43031   Determines whether graphic version of file exists
  43. '  HASHRBBS   58080   "Hash" to a user's record in the USERS file
  44. '  INITFMS    58160+  Initialize the RBBS-PC's File Management System
  45. '  INITIBM    30000   Open/create NETBIOS semaphore file
  46. '  INSCOMMA   58130   Format commands in the command prompt
  47. '  LIBRARY    21105   Provide support for "library" drives
  48. '  LOADNEW    58140   Find the latest uploads
  49. '  MODEMPUT   52070   Write a modem command string to the modem
  50. '  OPENMSG    30500   Open the messages file as file number 1
  51. '  PAGEUP     33202   Display user info. on local screen for SYSOP
  52. '  READPROF   44000   Read user's profile on return from a "door"
  53. '  SAVEPROF   43070   Save the user's provile when exiting to "doors" or DOS
  54. '  SENDNAME   20295   Send filename via EXEC-PC protocol during autodownload
  55. '  SETOPTS    58100   Set correct prompt line for each subsystem
  56. '  SRTSTRNG   58120   Sort characters in a string
  57. '  TESTUSER   20310   Check if user's software can do auto downloading
  58. '  TIMEREMAIN 41010   Compute time remaining in minutes
  59. '  UPDTUPLOAD 20705   Updates upload directory file
  60. '  WILDFILE   20290   Determines whether string matches a pattern
  61. '  XFERTYPE   21600   Identify the file transfer protocol
  62. '
  63. '  $INCLUDE: 'RBBS-VAR.BAS'
  64. '
  65. ' $SUBTITLE: 'WILDFILE -- Matches file to a filespec'
  66. ' $PAGE
  67. '  SUBROUTINE NAME    -- WILDFILE
  68. '
  69. '  INPUT PARAMETERS   -- PARAMETER             MEANING
  70. '                        PATTERN$           PATTERN TO CHECK AGAINST
  71. '                        ITEM.TO.MATCH$     FILE NAME TO MATCH
  72. '
  73. '  OUTPUT PARAMETERS     DOES.MATCH         WHETHER MATCHES
  74. '
  75. '  SUBROUTINE PURPOSE  DETERMINE WHETHER A FILE NAME IS AN INSTANCE OF
  76. '  A FILE SPECIFICATION.  EXACTLY LIKE DOS EXCEPT THAT ? MUST HAVE A
  77. '  CHARACTER.
  78. '
  79. 20290 SUB WILDFILE (PATTERN$,ITEM.TO.MATCH$,DOES.MATCH) STATIC
  80.       IF PATTERN$ <> PREV.PATTERN$ THEN _
  81.          CALL BRKFNAME (PATTERN$,PDR$,PPREFIX$,PEXT$,FALSE) : _
  82.          PREV.PATTERN$ = PATTERN$
  83.       CALL BRKFNAME (ITEM.TO.MATCH$,IDR$,IPREFIX$,IEXT$,FALSE)
  84.       DOES.MATCH = FALSE
  85.       IF PDR$ <> "" AND PDR$ <> IDR$ THEN _
  86.          EXIT SUB
  87.       CALL WILDCARD (PPREFIX$,IPREFIX$)
  88.       IF NOT OK THEN _
  89.          EXIT SUB
  90.       CALL WILDCARD (PEXT$,IEXT$)
  91.       DOES.MATCH = OK
  92.       END SUB
  93. ' $SUBTITLE: 'SENDNAME - send FILENAME using EXEC-PC protocol'
  94. ' $PAGE
  95. '
  96. '  SUBROUTINE NAME    -- SENDNAME
  97. '
  98. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  99. '                        B$()                ARRAY OF FILENAME FOR AUTODOWNLOAD
  100. '                        DWN.INDEX           INDEX OF FILENAME TO TRANSFER
  101. '
  102. '  OUTPUT PARAMETERS  -- ABORT               -1 FOR AN ABORTED ATTEMPT
  103. '
  104. '  SUBROUTINE PURPOSE -- SEND THE DOWNLOAD FILENAME TO USER DURING AN
  105. '                        AUTODOWNLOAD.
  106. '
  107.       SUB SENDNAME STATIC
  108. '
  109. ' *
  110. ' *  TRANSFER FILENAME TO USER                                                *
  111. ' *         PROCESS - SEND USER THE "ALERT" CHARACTER SEQUENCE -- <ESC>OD     *
  112. ' *                   THEN THIS IS FOLLOWED BY CHARACTER-BY-CHARACTER         *
  113. ' *                   TRANSMISSION OF THE FILENAME WITH ECHO.  IF ANY OF THE  *
  114. ' *                   CHARACTERS OF THE FILENMAE ARE GARBLED A SERIES OF      *
  115. ' *                   <CAN> ARE SENT, OTHERWISE AN <ACK> IS SENT AT           *
  116. ' *                   COMPLETION AND FILE TRANSFER BEGINS.                    *
  117. ' *
  118. '
  119.       ABORT = FALSE                      ' RESET ABORT FLAG
  120.       ATTEMPTS = 0                       ' RESET COUNT FOR # OF TRANS ATTEMPTS
  121. 20295 CALL DELAYIT (1)                   ' ONE SECOND DELAY
  122. 20296 CALL FLUSHCOM(Y$)                  ' CLEAR THE COMM BUFFER OF GARBAGE
  123.       IF SUBROUTINE.PARAMETER = -1 THEN _
  124.          EXIT SUB
  125.       CALL PUTCOM (ESCAPE$+"OD")         ' SEND "ALERT" STRING
  126.       IF SUBROUTINE.PARAMETER = -1 THEN _
  127.          EXIT SUB
  128.       IF ABORT = TRUE THEN _
  129.          GOTO 20306
  130.       CALL LPRNT("Sending FILENAME -- ",1)
  131.       CALL LPRNT(RETURN.LINE.FEED$ + CHR$(9),0)
  132.       CALL DELAYIT (1)                   ' WAIT 1 SECOND FOR SETUP
  133. '
  134. '               SEND ONE CHARACTER AT A TIME
  135. '
  136.       CALL BRKFNAME (B$(DWN.INDEX),X$,A$,Y$,TRUE)
  137.       A$ = A$ + Y$ + "=X"
  138.       FOR X = 1 TO LEN(A$)
  139.          CALL PUTCOM (MID$(A$,X,1))     ' SEND 1 CHARACTER
  140.          IF SUBROUTINE.PARAMETER = -1 THEN _
  141.             EXIT SUB
  142.          IF ABORT = TRUE THEN _
  143.             GOTO 20306
  144.          CALL LPRNT(MID$(A$,X,1),0)     ' DISPLAY IF NEEDED
  145.          IF TIMER < 86390! THEN _
  146.             DELAY! = TIMER + 10 _
  147.          ELSE DELAY! = TIMER - 86400! + 10 ' SET MAXIMUM TIME TO WAIT FOR REPLY
  148.          CHAR% = TRUE
  149.          WHILE CHAR% = -1
  150.             IF TIMER > DELAY! THEN _
  151.                GOTO 20300     ' IF NO ECHO, CANCEL FILENAME TRANSFER
  152.             CALL EOFCOMM (CHAR%)
  153.          WEND                 ' JUMP OUT IF CHARACTER IS RECEIVED
  154. 20298    CALL FLUSHCOM(Y$)    ' COLLECT CHARACTER(S) USER ECHOED
  155.          IF SUBROUTINE.PARAMETER = -1 THEN _
  156.             EXIT SUB
  157.          IF MID$(A$,X,1) = Y$ THEN _
  158.             GOTO 20305         ' IF CORRECTLY ECHOED, THEN CONTINUE
  159.          IF INSTR(Y$,CANCEL$) THEN _
  160.             ABORT = TRUE : _
  161.             GOTO 20306          ' CHECK FOR USER ABORT
  162. 20300    CALL PUTCOM (STRING$(5,24)) ' TELL USER THAT FILE NAME IS GARBLED
  163.          IF SUBROUTINE.PARAMETER = - 1 THEN _
  164.             EXIT SUB
  165.          IF ABORT = TRUE THEN _
  166.             GOTO 20306
  167.          CALL LPRNT("Name Trans Failure",1) ' DISPLAY FAILURE ON SCREEN
  168.          ATTEMPTS = ATTEMPTS + 1  ' INCREMENT COUNTER FOR # OF TRIES
  169.          IF ATTEMPTS < 6 THEN _   ' TRY IT FIVE TIMES, THEN GIVE UP
  170.             GOTO 20295
  171.          CALL PUTCOM (STRING$(50,24)) ' GUARANTEE CANCELLATION OF USER
  172.          IF SUBROUTINE.PARAMETER = -1 THEN _
  173.             EXIT SUB
  174.          IF ABORT = TRUE THEN _
  175.             GOTO 20306
  176.          IF SNOOP THEN _
  177.             CALL LPRNT("ABORTING AUTODOWNLOAD!",1) : _
  178.             ABORT = TRUE : _
  179.             GOTO 20306
  180. '
  181. 20305 NEXT                               ' LOOP BACK FOR NEXT CHARACTER
  182. '
  183.       CALL PUTCOM (ACKNOWLEDGE$)    ' WHEN FILENAME SENT, ACKNOWLEDGE
  184.       IF SUBROUITNE.PARAMETER = -1 THEN _
  185.          EXIT SUB
  186.       CALL SKIPLINE(1)              ' CLEAN UP SYSOP'S DISPLAY
  187. '
  188. '                COMPLETION OF AUTODOWNLOAD FILENAME TRANSFER
  189. '
  190. 20306 END SUB
  191. ' $SUBTITLE: 'TESTUSER - interrogate user for AUTO-DOWNLOADING protocol'
  192. ' $PAGE
  193. '
  194. '  SUBROUTINE NAME    -- TESTUSER
  195. '
  196. '  INPUT PARAMETERS   -- NONE
  197. '
  198. '  OUTPUT PARAMETERS  -- AUTODOWNLOAD.AVAILABLE   -1 IF USER'S COMMUNICATION
  199. '                                                      SOFTWARE CAN DO AUTO-
  200. '                                                      DOWNLOADING
  201. '
  202. '                        AUTODOWNLOAD.VERIFIED    TRUE IF COMMUNICATIONS PGM
  203. '                                                      EVER CHECKED
  204. '
  205. '  SUBROUTINE PURPOSE -- SEND THE USER AN <ESCAPE><XON> AND IF RESPONSE
  206. '                        IS A RECOGNIZED PACKAGE, SET APPROPRIATE FLAG.
  207. '
  208.       SUB TESTUSER STATIC
  209. '
  210. ' *
  211. ' *    TEST FOR COMMUNICATIONS USING N,8,1 PROTOCOL AND EXECPC TALK VER 2.0+  *
  212. ' *     TO SEE IF CALLER CAN USE THE AUTODOWNLOAD FEATURE                     *
  213. ' *
  214. '
  215. 20310 ABORT = FALSE
  216.       AUTODOWNLOAD.VERIFIED = TRUE
  217.       CALL FLUSHCOM(Y$)                          ' FLUSH THE COMM BUFFER
  218.       IF SUBROUTINE.PARAMETER = -1 THEN _
  219.          EXIT SUB
  220.       CALL PUTCOM (ESCAPE$ + XON$)
  221.       IF ABORT = TRUE THEN _
  222.          GOTO 20315
  223.       CALL DELAYIT (2)                            ' WAIT TWO SECONDS FOR REPLY
  224. 20313 CALL FLUSHCOM(Y$)                           ' GET CONTENTS OF COMM BUFFER
  225.       IF SUBROUTINE.PARAMETER = -1 THEN _
  226.          EXIT SUB
  227.       IF INSTR(Y$,"EXECPC") THEN _
  228.          COM.PROGRAM = 1
  229.       IF INSTR(Y$,"PIBTERM") THEN _
  230.          COM.PROGRAM = 2
  231.       IF INSTR(Y$,"PROCOMM") THEN _
  232.          COM.PROGRAM = 3
  233.       IF INSTR(Y$,"QMODEM") THEN _
  234.          COM.PROGRAM = 4
  235.       AUTODOWNLOAD.AVAILABLE = (COM.PROGRAM > 0 AND COM.PROGRAM < 3)
  236. 20315 END SUB
  237. ' $SUBTITLE: 'UPDTUPLOAD -- Updates upload directory'
  238. ' $PAGE
  239. '  SUBROUTINE NAME    -- UPDTUPLOAD
  240. '
  241. '  INPUT PARAMETERS   -- PARAMETER             MEANING
  242. '                        FILE.NAME$
  243. '                        UPLOAD.DIRECTORY$
  244. '                        FILE.NAME.HOLD$
  245. '                        SHARE.IT
  246. '                        FMS.DIRECTORY$
  247. '                        Q!
  248. '                        TCA!
  249. '
  250. '  OUTPUT PARAMETERS  -- BYTES.IN.FILE#
  251. '                        SECONDS.PER.SESSION!
  252. '
  253. '  SUBROUTINE PURPOSE -- UPON A SUCCESSFUL UPLOAD, ADD ENTRY TO THE UPLOAD
  254. '                        DIRECTORY AND GIVE ANY SESSION TIME CREDIT.
  255. '
  256.       SUB UPDTUPLOAD (CATEGORY.NAME$(1),CATEGORY.CODE$(1), LINES.IN.DESC) STATIC
  257. 20705 IF GET.EXT.DESC THEN _
  258.          GOTO 20723
  259.       CALL FINDIT (FILE.NAME$)
  260.       IF NOT OK THEN _
  261.          BYTES.IN.FILE# = 0.0_
  262.       ELSE BYTES.IN.FILE# = LOF(2)
  263.       IF BYTES.IN.FILE# < 2.0 THEN _
  264.          EXIT SUB
  265.       CALL QTPUT("Upload successful",1)
  266.       X$ = DATE$
  267.       Z$ = LEFT$(X$,6) + _
  268.            RIGHT$(X$,2)
  269.       STREW.TO$ = ""
  270.       UCAT$ = ""
  271. 20710 CALL QTPUT("Describe " + FILE.NAME.HOLD$ + _
  272.            " (Begin with '/' if for SYSOP only)",1)
  273.       CALL QTPUT(LEFT$(" |----+--Min<..-+---2+0---+---3+0---+---4+0---+-", _
  274.                  MAX.DESC.LEN - 4) + "..Max>",1)
  275.       A$ = ""
  276.       SUBROUTINE.PARAMETER = 1
  277.       PARSE.OFF = TRUE
  278.       CALL TGET
  279.       CALL CARRIER
  280.       IF SUBROUTINE.PARAMETER = -1 THEN _
  281.          B$ = "<description unavailable>": _
  282.          GOTO 20712
  283.       IF LEN(B$) > MAX.DESC.LEN OR LEN(B$) < 10 THEN _
  284.          GOTO 20710
  285. 20712 DESC$ = B$
  286.       IF NOT LIMIT.SEARCH.TO.FMS THEN _
  287.          IF FMS.DIRECTORY$ <> UPLOAD.DIRECTORY$ THEN _
  288.             IF LEFT$(B$,1) = "/" THEN _
  289.                CALL UPDTCALR (B$,2) : _
  290.                GOTO 20726_
  291.             ELSE GOTO 20717
  292. 20715 IF LEFT$(B$,1) = "/" THEN _
  293.          UCAT$ = "***" : _
  294.          GOTO 20722
  295.       UCAT$ = DEFAULT.CATEGORY.CODE$
  296. 20717 IF SUBROUTINE.PARAMETER = -1 OR _
  297.          USER.SECURITY.LEVEL < SL.CATEGORIZE.UPLOADS THEN _
  298.          GOTO 20722
  299. 20719 CALL BUFFILE (UPCAT.HELP$,X)
  300. 20720 A$= "Upload best fits what category (H=help)"
  301.       SUBROUTINE.PARAMETER = 1
  302.       CALL TGET
  303.       IF SUBROUTINE.PARAMETER = -1 THEN _
  304.          B$ = DEFAULT.CATEGORY.CODE$ : _
  305.          GOTO 20722
  306.       IF Q = 0 THEN _
  307.          GOTO 20719
  308.       CALL ALLCAPS (B$(1))
  309.       IF B$(1) = "H" OR _
  310.          B$(1) = "*" OR _
  311.          B$(1) = "?" THEN _
  312.          GOTO 20719
  313.       CALL CHKNARY (B$(1),CATEGORY.NAME$(),NUM.CATEGORIES,FOUND)
  314.       IF FOUND > 0 THEN _
  315.          UCAT$ = CATEGORY.CODE$(FOUND) : _
  316.          IF LEN(UCAT$) > 0 AND LEN(UCAT$) < 4 AND INSTR(UCAT$,",") = 0 THEN _
  317.             GOTO 20722
  318.       UCAT$ = ""
  319.       IF NOT LIMIT.SEARCH.TO.FMS THEN _
  320.          STREW.TO$ = DIRECTORY.PATH$ + _
  321.                      B$(1) + _
  322.                      "." + _
  323.                      DIRECTORY.EXTENTION$ : _
  324.          CALL FINDIT (STREW.TO$) : _
  325.          IF NOT OK THEN _
  326.             STREW.TO$ = "" _
  327.          ELSE GOTO 20722
  328.       CALL QTPUT ("No such category " + B$(1),1)
  329.       GOTO 20719
  330. 20722 IF USER.SECURITY.LEVEL >= ASK.EXTENDED.DESC AND _
  331.          MAX.EXTENDED.LINES > 0 AND SUBROUTINE.PARAMETER <> -1 THEN _
  332.          A$ = "Add an EXTENDED DESCRIPTION of " + _
  333.               FILE.NAME.HOLD$ + " ([Y],N)" : _
  334.          TURBO.KEY = -TURBO.KEY.USER : _
  335.          SUBROUTINE.PARAMETER = 1 : _
  336.          CALL TGET : _
  337.          IF SUBROUTINE.PARAMETER <> -1 THEN _
  338.             IF NOT NO THEN _
  339.                GET.EXT.DESC = TRUE : _
  340.                EXIT SUB
  341. 20723 B$ = DESC$
  342.       X$ = DATE$
  343.       Z$ = LEFT$(X$,6) + _
  344.            RIGHT$(X$,2)
  345.       EN$ = STREW.TO$
  346.       GOSUB 20730
  347.       EN$ = ALWAYS.STREW.TO$
  348.       GOSUB 20730
  349. 20725 EN$ = UPLOAD.DIRECTORY$
  350.       GOSUB 20730
  351. 20726 DF$ = " >> uploaded << "
  352.       UPLOADS = UPLOADS + 1
  353.       ULBYTES! = ULBYTES! + BYTES.IN.FILE#
  354.       CALL MUZAK (7)
  355.       CALL TIMEREMAIN (TIME.REMAINING!)
  356.       X! = UPLOAD.TIME.FACTOR! * (TCA! - Q!)
  357.       TIME.CREDITS! = TIME.CREDITS! + X!
  358.       SECONDS.PER.SESSION! = SECONDS.PER.SESSION! + X!
  359.       X! = (X! - TCA! + Q!)/60.0
  360.       IF X! > 1.0 THEN _
  361.          CALL QTPUT ("Uploads are appreciated here.  For today your",1) : _
  362.          CALL QTPUT ("SESSION & DAILY time limits increased by"+STR$(X!)+" minutes",1)
  363.       GET.EXT.DESC = FALSE
  364.       EXIT SUB
  365. 20730 '          ---[ lock file ]---
  366.       IF EN$ = "" THEN _
  367.          RETURN
  368.       FMS.FORMAT = FALSE
  369.       IF EN$ = FMS.DIRECTORY$ OR LIMIT.SEARCH.TO.FMS THEN _
  370.          FMS.FORMAT = TRUE _
  371.       ELSE CALL FINDIT (EN$) : _
  372.            IF OK THEN _
  373.               CALL READDIR (1) : _
  374.               IF EC = 0 THEN _
  375.                  FMS.FORMAT = (LEFT$(A$,4) = "\FMS")
  376.       IF NOT FMS.FORMAT THEN _
  377.          READ.BACKWARDS = FALSE : _
  378.          FIXED.LEN = 0 : _
  379.          B$ = DESC$ _
  380.       ELSE FIXED.LEN = 34 + MAX.DESC.LEN : _
  381.            B$ = DESC$ + _
  382.                 SPACE$(MAX.DESC.LEN - LEN(DESC$)) + _
  383.                 UCAT$ + _
  384.                 SPACE$(3 - LEN(UCAT$)) : _
  385.            READ.BACKWARDS = TRUE : _
  386.            CALL FINDIT (EN$) : _
  387.            IF OK THEN _
  388.               CALL READDIR (1) : _
  389.               IF EC = 0 THEN _
  390.                  READ.BACKWARDS = (INSTR(A$," TOP ") = 0)
  391.       BX = &H4
  392.       SUBROUTINE.PARAMETER = 9
  393.       CALL FILELOCK
  394.       CLOSE 2
  395.       IF SHARE.IT THEN _
  396.          OPEN EN$ FOR APPEND SHARED AS #2 _
  397.       ELSE OPEN "A",2,EN$
  398.       '          ---[ append ]---
  399.       IF GET.EXT.DESC THEN _
  400.          IF READ.BACKWARDS THEN _
  401.             FOR I = LINES.IN.DESC TO 1 STEP -1 : _
  402.                GOSUB 20732 : _
  403.             NEXT
  404.       PRINT #2,USING "\           \########  &  &"; _
  405.                      FILE.NAME.HOLD$; _
  406.                      BYTES.IN.FILE#; _
  407.                      Z$; _
  408.                      B$
  409.       IF GET.EXT.DESC THEN _
  410.          IF NOT READ.BACKWARDS THEN _
  411.             FOR I = 1 TO LINES.IN.DESC : _
  412.                GOSUB 20732 : _
  413.             NEXT
  414.       CLOSE 2
  415.       '          ---[ unlock ]---
  416.       BX = &H4
  417.       SUBROUTINE.PARAMETER = 10
  418.       CALL FILELOCK
  419.       FIXED.LEN = 0
  420.       RETURN
  421. 20732 X$ = A$(I)
  422.       CALL TRIM (X$)
  423.       IF X$ = "" THEN _
  424.          RETURN
  425.       IF NOT FMS.FORMAT THEN _
  426.          PRINT #2,"  ";A$(I) : _
  427.          RETURN
  428.       IF FIXED.LEN > LEN(A$(I)) THEN _
  429.          X$ = SPACE$(FIXED.LEN - 1 - LEN(A$(I))) + "." _
  430.       ELSE X$ = ""
  431.       PRINT #2, "  ";LEFT$(A$(I),FIXED.LEN);X$
  432.       RETURN
  433.       END SUB
  434. ' $SUBTITLE: 'BADFILE - subroutine to find bad file names'
  435. ' $PAGE
  436. '
  437. '  SUBROUTINE NAME    -- BADFILE
  438. '
  439. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  440. '                        VIOLATION$
  441. '                        VIOLATIONS.THIS.SESSION
  442. '                        FILNAME$                      NAME OF FILE
  443. '
  444. '  OUTPUT PARAMETERS  -- RESULT                      1 = FILE NAME IS OK
  445. '                                                    2 = CHARACTER NOT ALLOWED
  446. '                                                    3 = SYSTEM CRASH ATTEMPT
  447. '                        VIOLATIONS.THIS.SESSION     NUMBER OF VIOLATIONS
  448. '                        FILNAME$                    Gets capitalized
  449. '
  450. '  SUBROUTINE PURPOSE -- TO PROTECT RBBS-PC AGAINST THE USE OF BAD FILE NAMES
  451. '                        TO EITHER CRASH THE SYSTEM OR TO BREACH RBBS-PC'S
  452. '                        SECURITY
  453. '
  454.       SUB BADFILE (FILNAME$,RESULT) STATIC
  455. '
  456. ' *
  457. ' *  TEST FOR INVALID CHARACTERS IN FILENAME                                  *
  458. ' *
  459. '
  460. 20741 RESULT = 2
  461.       IF LEN(FILNAME$) < 1 THEN _
  462.          EXIT SUB
  463.       CALL ALLCAPS (FILNAME$)
  464.       IF INSTR(FILNAME$,"?") OR _
  465.          INSTR(FILNAME$,"*") OR _
  466.          INSTR(FILNAME$," ") OR _
  467.          INSTR(3,FILNAME$,":") OR _
  468.          INSTR(FILNAME$,".DEF") OR _
  469.          INSTR(FILNAME$,".MNU") OR _
  470.          INSTR(FILNAME$,".OLD") OR _
  471.          INSTR(FILNAME$,".PUI") OR _
  472.          MID$(FILNAME$,LEN(FILNAME$),1) = "." THEN _
  473.            EXIT SUB
  474.       XX = INSTR(FILNAME$,".")
  475.       IF XX > 0 THEN _
  476.          XX = INSTR(XX + 1,FILNAME$,".") : _
  477.          IF XX > 0 THEN _
  478.             EXIT SUB
  479.       XX = LEN(FILNAME$)
  480.       IF XX => 3 THEN _
  481.          IF INSTR("PRN:CON:AUX:NUL:",FILNAME$) THEN _
  482.             GOTO 20742
  483.       IF XX => 4 THEN _
  484.          IF INSTR("COM1:COM2:LPT1:LPT2:LPT3:SCRN:KYBD:CONS:",FILNAME$) THEN _
  485.             GOTO 20742
  486.       CALL BRKFNAME (FILNAME$,PRE$,BODY$,EXT$,FALSE)
  487.       IF LEN(PRE$) > 64 OR LEN(BODY$) > 8 OR LEN(BODY$) < 1 OR LEN(EXT$) > 3 THEN _
  488.          EXIT SUB
  489.       XX = LEN(BODY$)
  490.       IF XX => 3 THEN _
  491.          IF INSTR("PRN:CON:AUX:NUL:",BODY$) THEN _
  492.             GOTO 20742
  493.       IF XX => 4 THEN _
  494.          IF INSTR("COM1:COM2:LPT1:LPT2:LPT3:SCRN:KYBD:CONS:",BODY$) THEN _
  495.             GOTO 20742
  496.       RESULT = 1
  497.       EXIT SUB
  498. 20742 VIOLATIONS.THIS.SESSION = MAXIMUM.VIOLATIONS
  499.       VIOLATION$ = VIOLATION$ + _
  500.                    FILNAME$
  501.       RESULT = 3
  502.       END SUB
  503. '
  504. ' $SUBTITLE: 'LIBRARY - subroutine to support Library downloads'
  505. ' $PAGE
  506. '
  507. '  SUBROUTINE NAME    -- LIBRARY
  508. '
  509. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  510. '                            SUBROUTINE.PARAMETER     1 = DISPLAY ACTIVE AREA
  511. '                                                     2 = CHANGE ACTIVE AREA
  512. '                                                     3 = DISPLAY PC-SIG
  513. '                                                         DISCLAIMER
  514. '                                                     4 = ARCHIVE LIBRARY DISK
  515. '                                                     5 = DOWNLOAD COMPLETED
  516. '                            LIBRARY.TYPE             0 = NO LIBRARY ACTIVE
  517. '                                                     1 = LIBRARY FROM PC-SIG
  518. '                            LIBRARY.DRIVE$           LIBRARY DRIVE ID
  519. '
  520. '  OUTPUT PARAMETERS  -- NONE
  521. '
  522. '  SUBROUTINE PURPOSE -- TO PROVIDE ACCESSS SUPPORT FOR LIBRARY DRIVES
  523. '
  524.       SUB LIBRARY STATIC
  525.       STATIC LIBRARY.SUBDIR.NAME$(1)
  526.       STATIC DISK.TITLE$
  527.       EC = 0
  528. 21105 IF LIBRARY.TYPE = 0 THEN _
  529.          EXIT SUB
  530.       IF LIBRARY.DISK.CHAR$ = "" THEN _
  531.          LIBRARY.DISK.CHAR$ = "0000"
  532.       ON SUBROUTINE.PARAMETER GOTO 21110, 21115, 21130, 21140, 21159
  533. 21110 IF LIBRARY.DISK.CHAR$ = "0000" THEN _
  534.          A$ = "No Library disk currently selected" _
  535.       ELSE A$ = "Library disk " + _
  536.                 LIBRARY.DISK.CHAR$ + _
  537.                 " selected - " + _
  538.                 DISK.TITLE$
  539.       CALL QTPUT (A$,1)
  540.       IF LIBRARY.DISK.ARCHIVE$ = "" THEN _
  541.          EXIT SUB
  542.       FOR LIBRARY.DISPLAY.COUNT = 0 TO LIBRARY.LOOP.COUNT - 1
  543.          IF LIBRARY.SUBDIR.NAME$(LIBRARY.DISPLAY.COUNT) <> "" THEN _
  544.             CALL QTPUT (LIBRARY.SUBDIR.NAME$(LIBRARY.DISPLAY.COUNT) + _
  545.                        ".ARC ready for transmission!",1)
  546.       NEXT
  547.       EXIT SUB
  548. 21115 IF Q = 1 THEN _
  549.          A$ = "Change Library disk from " + _
  550.               LIBRARY.DISK.CHAR$ + _
  551.               " to (1 -" + _
  552.               STR$(LIBRARY.MAX.DISK) + _
  553.               ")" : _
  554.          SUBROUTINE.PARAMETER = 1 : _
  555.          CALL TGET : _
  556.          IF Q = 0 THEN _
  557.             LIBRARY.DISK.CHAR$ = "0000" : _
  558.             CHDIR.LIBRARY$ = LIBRARY.DRIVE$ + _
  559.                              "\" : _
  560.             GOTO 21126
  561. 21117 IF VAL(B$(Q)) < 1 OR VAL(B$(Q)) > LIBRARY.MAX.DISK THEN _
  562.          Q = 1 : _
  563.          GOTO 21115
  564. 21120 LIBRARY.DISK.CHAR$ = B$(Q)
  565.       CLOSE 2
  566.       LIBRARY.DISK.CHAR$ = RIGHT$("0000" + LIBRARY.DISK.CHAR$,4)
  567. 21121 CALL FINDIT("RBBS-CDR.DEF")
  568.       IF EC <> 0 THEN _
  569.          EXIT SUB
  570. 21122 IF EOF(2) THEN _
  571.          LIBRARY.DISK.CHAR$ = "" : _
  572.          EXIT SUB
  573.       INPUT #2,WORK.SUBDIR$,CHDIR.LIBRARY$
  574.       LINE INPUT #2,DISK.TITLE$
  575.       IF LIBRARY.DISK.CHAR$ = WORK.SUBDIR$ THEN _
  576.          CHDIR.LIBRARY$ = LIBRARY.DRIVE$ + _
  577.                           CHDIR.LIBRARY$ : _
  578.          GOTO 21126
  579.       GOTO 21122
  580. 21126 EC = 0
  581.       CALL CHANGEDIR (CHDIR.LIBRARY$)
  582.       IF EC <> 0 THEN _
  583.          LIBRARY.DISK.CHAR$ = "0000" : _
  584.          CHDIR.LIBRARY$ = LIBRARY.DRIVE$ + _
  585.                           "\" : _
  586.          GOTO 21126
  587.       EXIT SUB
  588. 21130 IF LIBRARY.TYPE <> 1 THEN _
  589.          EXIT SUB
  590.       CALL SKIPLINE(1)
  591.       A$ = "PC-SIG Library is being accessed.  The file that you are about"
  592.       CALL QTPUT (A$,1)
  593.       A$ = "to download can also be obtained by ordering DISK " + _
  594.            LIBRARY.DISK.CHAR$
  595.       CALL QTPUT (A$,1)
  596.       A$ = "from PC-SIG, 1030D East Duane Ave. Sunnyvale, Ca. 94086"
  597.       CALL QTPUT (A$,2)
  598.       EXIT SUB
  599. 21140 IF LIBRARY.DISK.CHAR$ = "0000" THEN _
  600.          CALL QTPUT ("You must select a LIBRARY disk first!",1) : _
  601.          EXIT SUB
  602.       A$ = "Archive contents of Library disk - " + _
  603.            LIBRARY.DISK.CHAR$ + _
  604.            " for data transmission (Y/[N])"
  605.       SUBROUTINE.PARAMETER = 1
  606.       CALL TGET
  607.       IF NOT LOCAL.USER THEN _
  608.          CALL CARRIER : _
  609.          IF SUBROUTINE.PARAMETER THEN _
  610.             EXIT SUB
  611.       IF NOT YES THEN _
  612.          EXIT SUB
  613. 21145 CALL KILLWORK (LIBRARY.WORK.DISK.PATH$ + _
  614.                     LIBRARY.NODE.ID$ + _
  615.                     "DK*.ARC")
  616. 21150 CALL QTPUT ("Work/RAM disk has been purged",1)
  617.       CALL QTPUT ("Beginning archive using " + _
  618.                   LIBRARY.ARCHIVE.PROGRAM$ + _
  619.                   " Please be patient!",1)
  620.       REDIM LIBRARY.SUBDIR.NAME$(10)
  621.       LIBRARY.SUBDIR.CHAR$ = ""
  622.       LIBRARY.LOOP.COUNT = 0
  623.       GOSUB 21157
  624.       A$ = "Contents of Library disk - " + _
  625.            LIBRARY.DISK.CHAR$ + _
  626.            " now archived for data transmission"
  627.       CALL QTPUT (A$,1)
  628.       A$ = "Searching for Sub-directories"
  629.       CALL QTPUT (A$,1)
  630.       GOSUB 21158
  631.       LIBRARY.DISK.ARCHIVE$ = LIBRARY.DISK.CHAR$
  632. '
  633. ' SEARCH AND ARCHIVE ANY SUBDIRECTORIES
  634. '
  635.       TREEDIR$ = LIBRARY.WORK.DISK.PATH$ + _
  636.                  LIBRARY.NODE.ID$ + _
  637.                  "DKDIR.LST"
  638.       DIRCMD$ = "DIR " + _
  639.                 LIBRARY.DRIVE$ + _
  640.                 " | FIND " +  _
  641.                 CHR$(34) + _
  642.                 " <DIR> " + _
  643.                 CHR$(34) + _
  644.                 "  > " + _
  645.                 TREEDIR$
  646. 21151 SHELL DIRCMD$
  647.       CALL SKIPLINE (2)
  648.       LOCATE 24,1
  649.       EC = 0
  650. 21152 CLOSE 2
  651. 21153 OPEN "I",2,TREEDIR$
  652.       LIBRARY.SUBDIR.COUNT = 0
  653.       WHILE NOT EOF(2)
  654.          LINE INPUT #2, DIRREC$
  655.          IF LEFT$(DIRREC$,1) <> "." THEN _
  656.             LIBRARY.SUBDIR.COUNT = LIBRARY.SUBDIR.COUNT + 1 : _
  657.             LIBRARY.SUBDIR.NAME$(LIBRARY.SUBDIR.COUNT) = _
  658.             LEFT$(DIRREC$,8)
  659.       WEND
  660.       CLOSE 2
  661.       LIBRARY.LOOP.COUNT = 1
  662.       IF LIBRARY.SUBDIR.COUNT = 0 THEN _
  663.          GOTO 21156
  664.       A$ = "There are" + STR$(LIBRARY.SUBDIR.COUNT) + _
  665.            " Subdirectories on LIBRARY disk - " + _
  666.            LIBRARY.DISK.CHAR$
  667.       CALL QTPUT(A$,1)
  668.       FOR LIBRARY.LOOP.COUNT = 1 TO LIBRARY.SUBDIR.COUNT
  669.          IF NOT LOCAL.USER THEN _
  670.             CALL CARRIER : _
  671.             IF SUBROUTINE.PARAMETER THEN _
  672.                GOTO 21155
  673.          LIBRARY.SUBDIR.CHAR$ = MID$("ABCDEFGHI",LIBRARY.LOOP.COUNT,1)
  674.          A$ = "Creating " + _
  675.               LIBRARY.NODE.ID$ + _
  676.               "DK" + _
  677.               LIBRARY.DISK.CHAR$ + _
  678.               LIBRARY.SUBDIR.CHAR$ + _
  679.               ".ARC using " + LIBRARY.ARCHIVE.PROGRAM$
  680.          CALL QTPUT(A$,1)
  681.          CHDIR CHDIR.LIBRARY$ + _
  682.                "\" + _
  683.                LIBRARY.SUBDIR.NAME$(LIBRARY.LOOP.COUNT)
  684.          GOSUB 21157
  685.          A$ = "Disk - " + _
  686.               LIBRARY.DISK.CHAR$ + _
  687.               "; Subdirectory" + _
  688.               " -" + _
  689.               STR$(LIBRARY.LOOP.COUNT) + _
  690.               " has been archived for data transmission"
  691.          CALL QTPUT(A$,1)
  692.          GOSUB 21158
  693. 21155 NEXT LIBRARY.LOOP.COUNT
  694. 21156 CALL CARRIER
  695.       A$ = ""
  696.       EXIT SUB
  697. 21157 LIBRARY.ARCHIVE$ = LIBRARY.ARCHIVE.PATH$ + _
  698.                        LIBRARY.ARCHIVE.PROGRAM$ + _
  699.                        " " + _
  700.                        LIBRARY.WORK.DISK.PATH$ + _
  701.                        LIBRARY.NODE.ID$ + _
  702.                        "DK" + _
  703.                        LIBRARY.DISK.CHAR$ + _
  704.                        LIBRARY.SUBDIR.CHAR$ + _
  705.                        " " + _
  706.                        LIBRARY.DRIVE$ + _
  707.                        "*.*"
  708. '     IF NOT LOCAL.USER THEN _
  709. '        LIBRARY.ARCHIVE$ = LIBRARY.ARCHIVE$ + " > " + COM.PORT$ + ":"
  710.       SHELL LIBRARY.ARCHIVE$
  711.       CALL SKIPLINE (2)
  712.       LOCATE 24,1
  713.       RETURN
  714. 21158 LIBRARY.SUBDIR.NAME$(LIBRARY.LOOP.COUNT) = LIBRARY.NODE.ID$ + _
  715.                                              "DK" + _
  716.                                              LIBRARY.DISK.CHAR$ + _
  717.                                              LIBRARY.SUBDIR.CHAR$
  718.       RETURN
  719. 21159 FOR LIBRARY.DISPLAY.COUNT = 0 TO LIBRARY.LOOP.COUNT - 1
  720.          IF LIBRARY.SUBDIR.NAME$(LIBRARY.DISPLAY.COUNT) = A$ THEN _
  721.             LIBRARY.SUBDIR.NAME$(LIBRARY.DISPLAY.COUNT) = ""
  722.       NEXT
  723.       END SUB
  724. ' $SUBTITLE: 'XFERTYPE - subroutine to identify file xfer protocol'
  725. ' $PAGE
  726. '
  727. '  SUBROUTINE NAME    -- XFERTYPE
  728. '
  729. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  730. '                        A$
  731. '                        B$(1)
  732. '                        KERMIT.SUPPORT
  733. '                        Q
  734. '                        RELIABLE.MODE
  735. '                        TRANSFER.OPTIONS$
  736. '                        USER.TRANSFER.DEFAULT$
  737. '                        XWMODEM.SUPPORT
  738. '                        XFER.SUPPORT
  739. '
  740. '  OUTPUT PARAMETERS  -- CHECKSUM
  741. '                        FLEN
  742. '                        FT$
  743. '
  744. '  SUBROUTINE PURPOSE -- TO IDENTIFY THE FILE TRANSFER PROTOCOL (EITHER
  745. '                        FROM THE USER'S DEFAULT OR VIA EXPLICIT SELECTION)
  746. '
  747.       SUB XFERTYPE(INDEX,SKIP.HELP) STATIC
  748.       IF USER.SECURITY.LEVEL <> PREV.USL THEN _
  749.          CALL PROTOCOL : _
  750.          PREV.USL = USER.SECURITY.LEVEL
  751.       X$ = A$ + "Protocol"
  752.       ON INDEX GOTO 21600,21620
  753. '
  754. ' *
  755. ' *  MANUAL SELECT OF TRANSFER PROTOCOL                                       *
  756. ' *
  757. '
  758. 21600 IF SKIP.HELP THEN _
  759.          GOTO 21604
  760. 21602 CALL BUFFILE (HELP.PATH$ + "UF" + HELP.EXTENSION$,X)
  761.       IF SUBROUTINE.PARAMETER = -1 THEN _
  762.          EXIT SUB
  763. 21604 CALL QTPUT (X$,1)
  764.       STOP.INTERRUPTS = TRUE
  765.       CALL BUFSTRNG (TRANSFER.OPTIONS$,4096,X)
  766.       A$ = ""
  767.       TURBO.KEY = -TURBO.KEY.USER
  768.       SUBROUTINE.PARAMETER = 1
  769.       CALL TGET
  770.       IF SUBROUTINE.PARAMETER = -1 THEN _
  771.          EXIT SUB
  772.       IF Q = 0 THEN _
  773.          GOTO 21604
  774.       Z$ = B$(1)
  775. '
  776. ' *
  777. ' *  DEFAULT SELECT OF TRANSFER PROTOCOL                                      *
  778. ' *
  779. '
  780. 21610 CALL ALLCAPS (Z$)
  781.       IF INSTR("H?",Z$) > 0 THEN _
  782.          GOTO 21602
  783.       FF = INSTR(DFLTXFER$,Z$)
  784.       IF FF < 1 THEN _
  785.          GOTO 21600
  786. 21612 FT$ = MID$(DFLTXFER$,FF,1)
  787.       INTERNAL.PROTO$ = MID$(INTERNAL.EQUIV$,FF,1)
  788.       'IF FF = LEN(DFLTXFER$) THEN _
  789.       '   PROTO.PROMPT$ = "None" : _
  790.       '   EXIT SUB
  791.       GOTO 21621
  792. 21620 FF = -1
  793.       IF COMMAND.TRANSFER$ <> "" THEN _
  794.          Z$ = COMMAND.TRANSFER$ : _
  795.          GOTO 21610
  796.       X = INSTR(DFLTXFER$,USER.TRANSFER.DEFAULT$)
  797.       IF X > 0 THEN _
  798.          IF MID$(INTERNAL.EQUIV$,X,1) <> "N" THEN _
  799.             Z$ = USER.TRANSFER.DEFAULT$ : _
  800.             GOTO 21610
  801.       PROTO.PROMPT$ = "None"
  802.       FF = 0
  803.       EXIT SUB
  804. 21621 IF FF = PREV.FF AND PREV.PROTO.DEF$ = PROTO.DEF$ THEN _
  805.          PROTO.PROMPT$ = PREV.PROTO.PROMPT$ : _
  806.          EXIT SUB
  807.       PREV.FF = FF
  808.       PREV.PROTO.DEF$ = PROTO.DEF$
  809.       INTERNAL.PROTO$ = MID$(INTERNAL.EQUIV$,FF,1)
  810.       CHECKSUM = (INTERNAL.PROTO$ = "X")
  811.       CALL FINDIT (PROTO.DEF$)
  812.       IF OK THEN _
  813.          GOTO 21623
  814.       X = INSTR("AXCYN",INTERNAL.PROTO$)
  815.       IF X < 1 THEN _
  816.          INTERNAL.PROTO$ = "N"
  817.       PROTO.PROMPT$ = MID$("Ascii     Xmodem    Xmodem/CRCYmodem    None",10*INSTR("AXCYN",INTERNAL.PROTO$)-9,10)
  818.       CALL TRIMTRAIL (PROTO.PROMPT$," ")
  819.       CHECKSUM = (INTERNAL.PROTO$ = "X")
  820.       FLEN = 128 - 896 * (INTERNAL.PROTO$ = "Y")
  821.       BLOCK.SIZE = FLEN
  822.       IF INTERNAL.PROTO$ = "Y" THEN _
  823.          SPEED.FACTOR! = 0.87 _
  824.       ELSE IF INTERNAL.PROTO$ = "A" THEN _
  825.          SPEED.FACTOR! = 0.92 _
  826.       ELSE SPEED.FACTOR! = 0.78
  827.       GOTO 21625
  828. 21623 CALL READPARMS (WORK.ARA$(),13,FF)
  829.       IF EC > 0 THEN _
  830.          FF = LEN(DFLTXFER$) : _
  831.          EXIT SUB
  832.       PROTO.PROMPT$ = WORK.ARA$(1)
  833.       IF LEN(PROTO.PROMPT$) > 2 THEN _
  834.          IF MID$(PROTO.PROMPT$,2,1) = ")" THEN _
  835.             PROTO.PROMPT$ = LEFT$(PROTO.PROMPT$,1) + MID$(PROTO.PROMPT$,3)
  836.       X = INSTR(PROTO.PROMPT$+CRLF$,CRLF$)
  837.       PROTO.PROMPT$ = LEFT$(PROTO.PROMPT$,X-1)
  838.       CALL TRIM (PROTO.PROMPT$)
  839.       PROTO.METHOD$ = LEFT$(WORK.ARA$(3),1)
  840.       CALL ALLCAPS (PROTO.METHOD$)
  841.       REQ.8.BIT = (LEFT$(WORK.ARA$(4),1) = "8")
  842.       DOWN.TEMPLATE$ = WORK.ARA$(12)
  843.       UP.TEMPLATE$ = WORK.ARA$(13)
  844.       X$ = WORK.ARA$(11)
  845.       X = INSTR(X$,"=")
  846.       ADVANCE.PROTO.WRITE = FALSE
  847.       IF X < 2 OR X >= LEN(X$) THEN _
  848.          FAILURE.PARM = 4 : _
  849.          FAILURE.STRING$ = "F" _
  850.       ELSE FAILURE.PARM = VAL(LEFT$(X$,X-1)) : _
  851.            FAILURE.STRING$ = MID$(X$,X+1) : _
  852.            X = INSTR(FAILURE.STRING$,"=") : _
  853.            IF X > 0 THEN _
  854.               ADVANCE.PROTO.WRITE = (MID$(FAILURE.STRING$,X) = "=A") : _
  855.               FAILURE.STRING$ = LEFT$(FAILURE.STRING$,X-1)
  856.       PROTO.MACRO$ = WORK.ARA$(10)
  857.       FAKE.XRPT = (LEFT$(WORK.ARA$(8),1) = "F")
  858.       BATCH.PROTO = (LEFT$(WORK.ARA$(6),1) = "B")
  859.       SPEED.FACTOR! = VAL(WORK.ARA$(9))
  860.       IF SPEED.FACTOR! < 0.1 THEN _
  861.          SPEED.FACTOR! = 0.87
  862.       BLOCK.SIZE = VAL(WORK.ARA$(7))
  863.       FLEN = BLOCK.SIZE
  864.       IF FLEN < 1 THEN _
  865.          FLEN = 128
  866. 21625 PREV.PROTO.PROMPT$ = PROTO.PROMPT$
  867.       END SUB
  868. ' $SUBTITLE: 'FILELOCK - subroutine to share RBBS-PC files'
  869. ' $PAGE
  870. '
  871. '  SUBROUTINE NAME    -- FILELOCK
  872. '
  873. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  874. '                        SUBROUTINE.PARAMETER = 1 UNLOCK USERS AND MESSAGES
  875. '                                               2 FLUSH MESSAGE RECORD TO DISK
  876. '                                                 AND UNLOCK MESSAGES
  877. '                                               3 LOCK MESSAGE FILE
  878. '                                               4 UNLOCK MESSAGE FILE
  879. '                                               5 LOCK USER FILE
  880. '                                               6 LOCK 4 RECORD BLOCK IN USER
  881. '                                                 FILE
  882. '                                               7 UNLOCK USER FILE
  883. '                                               8 UNLOCK 4 RECORD BLOCK IN USER
  884. '                                                 FILE
  885. '                                               9 LOCK UPLOAD DIRECTORY OR
  886. '                                                 COMMENTS FILE
  887. '                                              10 UNLOCK UPLOAD DIRECTORY OR
  888. '                                                 COMMENTS FILE
  889. '                        ACTIVE.MESSAGE FILE$   NAME OF MESSAGE FILE
  890. '                        ACTIVE.USER.FILE$      NAME OF USER FILE
  891. '                        CONFIG.FILE.NAME$      FILE NAME TO FLUSH RECORD FROM
  892. '                        EN$                    UPLOAD DIRECTORY OR COMMENTS
  893. '                                               FILE NAME TO LOCK/UNLOCK
  894. '                        NETWORK.TYPE           TYPE OF NETWORK LOCKING TO USE
  895. '
  896. '  OUTPUT PARAMETERS  -- SUBROUTINE.PARAMETER = -1 TERMINATE RBBS-PC IMMEDATELY
  897. '                        BLK
  898. '                        LOCK.DRIVE
  899. '                        LOCK.FILE.NAME$
  900. '                        LOCK.STATUS$
  901. '                        MESSAGE.FILE.LOCK
  902. '                        USER.BLOCK.LOCK
  903. '                        USER.FILE.LOCK
  904. '                        USER.FILE.INDEX
  905. '
  906. '  SUBROUTINE PURPOSE -- TO LOCK AND UNLOCK THE SHARED RBBS-PC FILES WHEN
  907. '                        MULTIPLE COPIES OF RBBS-PC ARE SHARING THE SAME
  908. '                        FILES IN EITHER A MULTI-TASKING DOS ENVIRONMENT OR
  909. '                        IN A LOCAL AREA NETWORK ENVIRONMENT
  910.       SUB FILELOCK STATIC
  911.       ON SUBROUTINE.PARAMETER GOSUB 21995,21996,22000,25000,26000, _
  912.                                     26500,27000,27500,29000,29500
  913.       EXIT SUB
  914. '
  915. ' *
  916. ' *  UNLOCK USERS AND MESSAGES                                                *
  917. ' *
  918. '
  919. 21995 GOSUB 27000
  920.       GOSUB 25000
  921.       RETURN
  922. '
  923. ' *
  924. ' *  FLUSH MESSAGE FILE DATA TO DISK BY OPENING DUMMY FILE # 1                *
  925. ' *
  926. '
  927. 21996 CLOSE 1
  928.       IF SHARE.IT THEN _
  929.          OPEN CONFIG.FILENAME$ FOR INPUT SHARED AS #1 _
  930.       ELSE OPEN "I",1,CONFIG.FILENAME$
  931. '
  932. ' *
  933. ' *  UNLOCK MESSAGES                                                          *
  934. ' *
  935. '
  936.       GOSUB 25000
  937.       CALL OPENMSG
  938.       RETURN
  939. '
  940. ' *
  941. ' *  LOCK MESSAGE FILE                                                        *
  942. ' *
  943. '
  944. 22000 IF MESSAGE.FILE.LOCK = TRUE THEN _
  945.          RETURN
  946.       MESSAGE.FILE.LOCK = TRUE
  947.       MID$(LOCK.STATUS$,1,2) = "LM"
  948.       SUBROUTINE.PARAMETER = 2
  949.       CALL LINE25
  950.       LOCK.FILE.NAME$ = ACTIVE.MESSAGE.FILE$
  951.       ON NETWORK.TYPE GOTO 22100,22200,22300,22400,22500,29700
  952.       RETURN
  953. '
  954. ' *
  955. ' *  LOCK MESSAGE FILE (MULTI-LINK)                                           *
  956. ' *
  957. '
  958. 22100 AX = &H0
  959.       BX = &H1
  960.       IF MULTI.LINK.PRESENT > 0 THEN _
  961.          CALL RBBSML(AX,BX)
  962.       RETURN
  963. '
  964. ' *
  965. ' *  LOCK MESSAGE FILE (OMNINET)                                              *
  966. ' *
  967. '
  968. 22200 CC$ = CHR$(1) + _
  969.             MID$(ACTIVE.MESSAGE.FILE$ + SPACE$(8),3,8)
  970.       GOSUB 28000
  971.       IF CT = 0 THEN _
  972.          RETURN
  973.       CALL DELAYIT (1)
  974.       GOTO 22200
  975. '
  976. ' *
  977. ' *  LOCK MESSAGE FILE (ORCHID PC-NET)                                        *
  978. ' *  LOCK USER FILE (ORCHID PC-NET)                                           *
  979. ' *  LOCK UPLOAD DIRECTORY OR COMMENTS BASED ON EN$ (ORCHID PC-NET)           *
  980. ' *
  981. '
  982. 22300 GOSUB 28100
  983.       CALL LPLKIT(LOCK.DRIVE,LOCK.FILE.NAME$,A)
  984.       RETURN
  985. '
  986. ' *
  987. ' *  LOCK SYSTEM (DESQview)                                                   *
  988. ' *
  989. '
  990. 22400 AX = 1
  991.       BX = 0
  992.       CALL RBBSDV(AX,BX)
  993.       RETURN
  994. '
  995. ' *
  996. ' *  LOCK MESSAGE FILE (10 NET)                                               *
  997. ' *  LOCK USER FILE (10 NET)                                                  *
  998. ' *  LOCK UPLOAD DIRECTORY OR COMMENTS BASED ON EN$ (10 NET)                  *
  999. ' *
  1000. '
  1001. 22500 GOSUB 28100
  1002.       CALL LPLK10(LOCK.DRIVE,LOCK.FILE.NAME$,A)
  1003.       RETURN
  1004. '
  1005. ' *
  1006. ' *  UNLOCK MESSAGE FILE                                                      *
  1007. ' *
  1008. '
  1009. 25000 IF NOT MESSAGE.FILE.LOCK THEN _
  1010.          RETURN
  1011.       MESSAGE.FILE.LOCK = FALSE
  1012.       MID$(LOCK.STATUS$,1,2) = "UM"
  1013.       SUBROUTINE.PARAMETER = 2
  1014.       CALL LINE25
  1015.       LOCK.FILE.NAME$ = ACTIVE.MESSAGE.FILE$
  1016.       ON NETWORK.TYPE GOTO 25100,25200,25300,25400,25500,29800
  1017.       RETURN
  1018. '
  1019. ' *
  1020. ' *  UNLOCK MESSAGE FILE (MULTI-LINK)                                         *
  1021. ' *
  1022. '
  1023. 25100 AX = &H100
  1024.       BX = &H1
  1025.       IF MULTI.LINK.PRESENT > 0 THEN _
  1026.          CALL RBBSML(AX,BX)
  1027.       RETURN
  1028. '
  1029. ' *
  1030. ' *  UNLOCK MESSAGE FILE (OMNINET)                                            *
  1031. ' *
  1032. '
  1033. 25200 CC$ = CHR$(17) + _
  1034.             MID$(ACTIVE.MESSAGE.FILE$ + SPACE$(8),3,8)
  1035.       GOSUB 28000
  1036.       IF CT = 128 THEN _
  1037.          RETURN
  1038.       CALL DELAYIT (1)
  1039.       GOTO 25200
  1040. '
  1041. ' *
  1042. ' *  UNLOCK MESSAGE FILE (ORCHID PC-NET)                                      *
  1043. ' *  UNLOCK USER FILE (ORCHID PC-NET)                                         *
  1044. ' *  UNLOCK UPLOAD DIRECTORY OR COMMENTS BASED ON EN$ (ORCHID PC-NET)         *
  1045. ' *
  1046. '
  1047. 25300 GOSUB 28100
  1048.       CALL UNLOKIT(LOCK.DRIVE,LOCK.FILE.NAME$,A)
  1049.       RETURN
  1050. '
  1051. ' *
  1052. ' *  UNLOCK SYSTEM (DESQview)                                                 *
  1053. ' *
  1054. '
  1055. 25400 AX = 2
  1056.       BX = 0
  1057.       CALL RBBSDV(AX,BX)
  1058.       RETURN
  1059. '
  1060. ' *
  1061. ' *  UNLOCK MESSAGE FILE (10 NET)                                             *
  1062. ' *  UNLOCK USER FILE (10 NET)                                                *
  1063. ' *  UNLOCK UPLOAD DIRECTORY OR COMMENTS BASED ON EN$ (10 NET)                *
  1064. ' *
  1065. '
  1066. 25500 GOSUB 28100
  1067.       CALL UNLOK10(LOCK.DRIVE,LOCK.FILE.NAME$,A)
  1068.       RETURN
  1069.  
  1070. '
  1071. ' *
  1072. ' *  LOCK USER FILE                                                           *
  1073. ' *
  1074. '
  1075. 26000 IF USER.FILE.LOCK = TRUE THEN _
  1076.          RETURN
  1077.       USER.FILE.LOCK = TRUE
  1078.       MID$(LOCK.STATUS$,4,2) = "LU"
  1079.       SUBROUTINE.PARAMETER = 2
  1080.       CALL LINE25
  1081.       LOCK.FILE.NAME$ = ACTIVE.USER.FILE$
  1082.       ON NETWORK.TYPE GOTO 26100,26200,22300,22400,22500,29720
  1083.       RETURN
  1084. '
  1085. ' *
  1086. ' *  LOCK USER FILE (MULTI-LINK)                                              *
  1087. ' *
  1088. '
  1089. 26100 AX = &H0
  1090.       BX = &H2
  1091.       IF MULTI.LINK.PRESENT > 0 THEN _
  1092.          CALL RBBSML(AX,BX)
  1093.       RETURN
  1094. '
  1095. ' *
  1096. ' *  LOCK USER FILE (OMNINET)                                                 *
  1097. ' *
  1098. '
  1099. 26200 CC$ = CHR$(1) + _
  1100.             MID$(ACTIVE.USER.FILE$ + SPACE$(8),3,8)
  1101.       GOSUB 28000
  1102.       IF CT = 0 THEN _
  1103.          RETURN
  1104.       CALL DELAYIT (1)
  1105.       GOTO 26200
  1106. '
  1107. ' *
  1108. ' *  LOCK 4 RECORD BLOCK IN USER FILE                                         *
  1109. ' *
  1110. '
  1111. 26500 IF USER.BLOCK.LOCK = TRUE THEN _
  1112.          RETURN
  1113.       USER.BLOCK.LOCK = TRUE
  1114.       BLK = (USER.FILE.INDEX / 4) + .26
  1115.       MID$(LOCK.STATUS$,7,2) = "LB"
  1116.       SUBROUTINE.PARAMETER = 2
  1117.       CALL LINE25
  1118.       ON NETWORK.TYPE GOTO 26600,26700,26800,22400,26900,29730
  1119.       RETURN
  1120. '
  1121. ' *
  1122. ' *  LOCK 4 RECORD BLOCK IN USER FILE (MULTI-LINK)                            *
  1123. ' *
  1124. '
  1125. 26600 AX = &H0
  1126.       BX = BLK + 10
  1127.       IF MULTI.LINK.PRESENT > 0 THEN _
  1128.          CALL RBBSML(AX,BX)
  1129.       RETURN
  1130. '
  1131. ' *
  1132. ' *  LOCK 4 RECORD BLOCK IN USER FILE (OMNINET)                               *
  1133. ' *
  1134. '
  1135. 26700 CC$ = CHR$(1) + _
  1136.             "BLK" + _
  1137.             RIGHT$("0000" + MID$(STR$(BLK),2),5)
  1138.       GOSUB 28000
  1139.       IF CT = 0 THEN _
  1140.          RETURN
  1141.       CALL DELAYIT (1)
  1142.       GOTO 26700
  1143. '
  1144. ' *
  1145. ' *  LOCK 4 RECORD BLOCK IN USER FILE (ORCHID PC-NET)                         *
  1146. ' *
  1147. '
  1148. 26800 LOCK.FILE.NAME$ = LEFT$(ACTIVE.USER.FILE$,2) + _
  1149.                         "BLK" + _
  1150.                         RIGHT$("0000" + MID$(STR$(BLK),2),5)
  1151.       GOTO 22300
  1152. '
  1153. ' *
  1154. ' *  LOCK 4 RECORD BLOCK IN USER FILE (10 NET)                                *
  1155. ' *
  1156. '
  1157. 26900 LOCK.FILE.NAME$ = LEFT$(ACTIVE.USER.FILE$,2) + _
  1158.                         "BLK" + _
  1159.                         RIGHT$("0000" + MID$(STR$(BLK),2),5)
  1160.       GOTO 22500
  1161. '
  1162. ' *
  1163. ' *  UNLOCK USER FILE                                                         *
  1164. ' *
  1165. '
  1166. 27000 IF NOT USER.FILE.LOCK THEN _
  1167.          RETURN
  1168.       USER.FILE.LOCK = FALSE
  1169.       MID$(LOCK.STATUS$,4,2) = "UU"
  1170.       SUBROUTINE.PARAMETER = 2
  1171.       CALL LINE25
  1172.       LOCK.FILE.NAME$ = ACTIVE.USER.FILE$
  1173.       ON NETWORK.TYPE GOTO 27100,27200,25300,25400,25500,29820
  1174.       RETURN
  1175. '
  1176. ' *
  1177. ' *  UNLOCK USER FILE (MULTI-LINK)                                            *
  1178. ' *
  1179. '
  1180. 27100 AX = &H100
  1181.       BX = &H2
  1182.       IF MULTI.LINK.PRESENT > 0 THEN _
  1183.          CALL RBBSML(AX,BX)
  1184.       RETURN
  1185. '
  1186. ' *
  1187. ' *  UNLOCK USER FILE (OMNINET)                                               *
  1188. ' *
  1189. '
  1190. 27200 CC$ = CHR$(17) + _
  1191.             MID$(ACTIVE.USER.FILE$ + SPACE$(8),3,8)
  1192.       GOSUB 28000
  1193.       IF CT = 128 THEN _
  1194.          RETURN
  1195.       CALL DELAYIT (1)
  1196.       GOTO 27200
  1197.  
  1198. '
  1199. ' *
  1200. ' *  UNLOCK 4 RECORD BLOCK IN USER FILE                                       *
  1201. ' *
  1202. '
  1203. 27500 IF NOT USER.BLOCK.LOCK THEN _
  1204.          RETURN
  1205.       USER.BLOCK.LOCK = FALSE
  1206.       BLK = (USER.FILE.INDEX / 4) + .26
  1207.       MID$(LOCK.STATUS$,7,2) = "UB"
  1208.       SUBROUTINE.PARAMETER = 2
  1209.       CALL LINE25
  1210.       ON NETWORK.TYPE GOTO 27600,27700,27800,25400,27900,29830
  1211.       RETURN
  1212. '
  1213. ' *
  1214. ' *  UNLOCK 4 RECORD BLOCK IN USER FILE (MULTI-LINK)                          *
  1215. ' *
  1216. '
  1217. 27600 AX = &H100
  1218.       BX = BLK + 10
  1219.       IF MULTI.LINK.PRESENT > 0 THEN _
  1220.          CALL RBBSML(AX,BX)
  1221.       RETURN
  1222. '
  1223. ' *
  1224. ' *  UNLOCK 4 RECORD BLOCK IN USER FILE (OMNINET)                             *
  1225. ' *
  1226. '
  1227. 27700 CC$ = CHR$(17) + _
  1228.             "BLK" + _
  1229.             RIGHT$("0000" + MID$(STR$(BLK),2),5)
  1230.       GOSUB 28000
  1231.       IF CT = 128 THEN _
  1232.          RETURN
  1233.       CALL DELAYIT (1)
  1234.       GOTO 27700
  1235. '
  1236. ' *
  1237. ' *  UNLOCK 4 RECORD BLOCK IN USER FILE (ORCHID PC-NET)                       *
  1238. ' *
  1239. '
  1240. 27800 LOCK.FILE.NAME$ = LEFT$(ACTIVE.USER.FILE$,2) + _
  1241.                         "BLK" + _
  1242.                         RIGHT$("0000" + MID$(STR$(BLK),2),5)
  1243.       GOTO 25300
  1244. '
  1245. ' *
  1246. ' *  UNLOCK 4 RECORD BLOCK IN USER FILE (ORCHID PC-NET)                       *
  1247. ' *
  1248. '
  1249. 27900 LOCK.FILE.NAME$ = LEFT$(ACTIVE.USER.FILE$,2) + _
  1250.                         "BLK" + _
  1251.                         RIGHT$("0000" + MID$(STR$(BLK),2),5)
  1252.       GOTO 25500
  1253. '
  1254. ' *
  1255. ' *  CORVUS OMNINET INTERFACE                                                 *
  1256. ' *
  1257. '
  1258. 28000 CC$ = LINE.FEED$ + _
  1259.             CHR$(0) + _
  1260.             CHR$(11) + _
  1261.             CC$
  1262.       CALL CDSEND(CC$)
  1263.       CALL CDRECV(CN$)
  1264.       CT = ASC(MID$(CN$,3,1))
  1265.       IF CT => 128 THEN _
  1266.          CALL LPRNT("CORVUS LOCK FAIL",1) : _
  1267.          SUBROUTINE.PARAMETER = -1
  1268. 28010 CT = ASC(MID$(CN$,4,1))
  1269.       IF CT => 129 THEN _
  1270.          CALL LPRNT("CORVUS FULL",1) : _
  1271.          SUBROUTINE.PARAMETER = -1
  1272.       RETURN
  1273. '
  1274. ' *
  1275. ' *  ORCHID PC-NET & 10 NET INTERFACE                                         *
  1276. ' *
  1277. '
  1278. 28100 CALL ALLCAPS (LOCK.FILE.NAME$)
  1279.       LOCK.DRIVE = ASC(LEFT$(LOCK.FILE.NAME$,1)) - ASC("A")
  1280.       LOCK.FILE.NAME$ = LOCK.FILE.NAME$ + _
  1281.                         STRING$(32 - LEN(LOCK.FILE.NAME$),0)
  1282.       A = 0
  1283.       RETURN
  1284. '
  1285. ' *
  1286. ' *  LOCK UPLOAD DIRECTORY OR COMMENTS BASED ON EN$                           *
  1287. ' *
  1288. '
  1289. 29000 IF LOCKED.EN$ = EN$ THEN _
  1290.          RETURN
  1291.       LOCKED.EN$ = EN$
  1292.       MID$(LOCK.STATUS$,10,2) = "LD"
  1293.       SUBROUTINE.PARAMETER = 2
  1294.       CALL LINE25
  1295.       LOCK.FILE.NAME$ = EN$
  1296.       ON NETWORK.TYPE GOTO 29100,29010,22300,22400,22500,29710
  1297. 29010 RETURN
  1298. '
  1299. ' *
  1300. ' *  LOCK UPLOAD DIRECTORY OR COMMENTS BASED ON EN$ (MULTI-LINK)              *
  1301. ' *
  1302. '
  1303. 29100 AX = &H0
  1304.       BX = &H3
  1305.       IF MULTI.LINK.PRESENT > 0 THEN _
  1306.          CALL RBBSML(AX,BX)
  1307.       RETURN
  1308. '
  1309. ' *
  1310. ' *  UNLOCK UPLOAD DIRECTORY OR COMMENTS BASED ON EN$                         *
  1311. ' *
  1312. '
  1313. 29500 IF LOCKED.EN$ <> EN$ THEN _
  1314.          RETURN
  1315.       LOCKED.EN$ = ""
  1316.       MID$(LOCK.STATUS$,10,2) = "UD"
  1317.       SUBROUTINE.PARAMETER = 2
  1318.       CALL LINE25
  1319.       LOCK.FILE.NAME$ = EN$
  1320.       ON NETWORK.TYPE GOTO 29600,29510,25300,25400,25500,29810
  1321. 29510 RETURN
  1322. '
  1323. ' *
  1324. ' *  UNLOCK UPLOAD DIRECTORY OR COMMENTS BASED ON EN$ (MULTI-LINK)            *
  1325. ' *
  1326. '
  1327. 29600 AX = &H100
  1328.       BX = &H3
  1329.       IF MULTI.LINK.PRESENT > 0 THEN _
  1330.          CALL RBBSML(AX,BX)
  1331.       EXIT SUB
  1332. '
  1333. ' *
  1334. ' *  NETBIOS SEMAPHORE LOCK MECHANISM                                         *
  1335. ' *     Only the USERS file is actually locked.  All other files are locked   *
  1336. ' *     by means of the semaphore file IBMFLAGS.  Each IBMFLAGS record is a   *
  1337. ' *     file semaphore as follows:                                            *
  1338. ' *        RECORD 1 = MESSAGES file lock status                               *
  1339. ' *        RECORD 2 = Comments/Upload dir locked                              *
  1340. ' *        RECORD 3 = entire USERS file lock                                  *
  1341. ' *
  1342. '
  1343. ' * Lock MESSAGES
  1344. 29700 CALL NETBIOS (1,6,1)
  1345.       RETURN
  1346.  
  1347. ' * Lock Comments/Upload dir
  1348. 29710 CALL NETBIOS (1,6,2)
  1349.       RETURN
  1350.  
  1351. ' * Lock USERS file
  1352. 29720 CALL NETBIOS (1,6,3)
  1353.       RETURN
  1354.  
  1355. ' * Lock single USERS record
  1356. 29730 CALL NETBIOS (1,6,3)
  1357. '9730 CALL NETBIOS (1,5,USER.FILE.INDEX)
  1358.       RETURN
  1359.  
  1360. ' * UNLOCK MESSAGES
  1361. 29800 CALL NETBIOS (0,6,1)
  1362.       RETURN
  1363.  
  1364. ' * UNLOCK Comments/Upload dir
  1365. 29810 CALL NETBIOS (0,6,2)
  1366.       RETURN
  1367.  
  1368. ' * UNLOCK USERS file
  1369. 29820 CALL NETBIOS (0,6,3)
  1370.       RETURN
  1371.  
  1372. ' * UNLOCK single USERS record
  1373. 29830 CALL NETBIOS (0,6,3)
  1374. '9830 CALL NETBIOS (0,5,USER.FILE.INDEX)
  1375.       RETURN
  1376.       END SUB
  1377. ' $SUBTITLE: 'INITIBM - subroutine to create/open NETBIOS semaphore file'
  1378. ' $PAGE
  1379. '
  1380. '  SUBROUTINE NAME    -- INITIBM   (Written by Doug Azzarito)
  1381. '
  1382. '  INPUT PARAMETERS   -- NONE
  1383. '
  1384. '  OUTPUT PARAMETERS  -- SUBROUTINE.PARAMETER = -1   ABORT RBBS
  1385. '
  1386. '  SUBROUTINE PURPOSE -- OPEN SEMAPHORE FILE "IBMFLAGS" ON DEFAULT DRIVE
  1387. '                        AS FILE #6
  1388. '                        IF FILE DOES NOT EXIST, IT IS CREATED.
  1389. '
  1390.       SUB INITIBM STATIC
  1391. '
  1392. ' *
  1393. ' *  SEE IF FILE EXISTS                                                       *
  1394. ' *
  1395. '
  1396. 30000 SHARE.IT = TRUE
  1397.       FOR I = LEN(MAIN.MESSAGE.FILE$) TO 0 STEP -1
  1398.          IF I = 0 THEN _
  1399.             GOTO 30010
  1400.          IF MID$(MAIN.MESSAGE.FILE$,I,1) = ":" OR _
  1401.             MID$(MAIN.MESSAGE.FILE$,I,1) = "\" THEN _
  1402.             GOTO 30010
  1403.       NEXT
  1404. 30010 IBM.FLAG.FILE$ = LEFT$(MAIN.MESSAGE.FILE$,I) + _
  1405.                        "IBMFLAGS"
  1406.       CALL FINDIT (IBM.FLAG.FILE$)
  1407.       CLOSE 2
  1408.       IF OK THEN _
  1409.          GOTO 30020
  1410. '
  1411. ' *
  1412. ' *  CREATE A NEW FILE, EACH RECORD IS A SEMAPHORE                            *
  1413. ' *
  1414. '
  1415.       OPEN IBM.FLAG.FILE$ ACCESS WRITE AS #6 LEN=2
  1416.       FIELD 6, 2 AS LOCKBUF$
  1417.       LSET LOCKBUF$ = MKI$(0)
  1418.       FOR I = 1 TO 3
  1419.          PUT 6
  1420.       NEXT
  1421.       CLOSE #6
  1422. 30020 OPEN IBM.FLAG.FILE$ ACCESS READ WRITE SHARED AS #6 LEN=2
  1423.       END SUB
  1424. ' $SUBTITLE: 'OPENMSG - open the MESSAGES file'
  1425. ' $PAGE
  1426. '
  1427. '  SUBROUTINE NAME    -- OPENMSG
  1428. '
  1429. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  1430. '                         ACTIVE.MESSAGE.FILE$
  1431. '                         SHARE.IT
  1432. '
  1433. '  OUTPUT PARAMETERS  --  MESSAGE.RECORD$
  1434. '
  1435.       SUB OPENMSG STATIC
  1436. '
  1437. ' *
  1438. ' *  OPEN AND DEFINE MESSAGE FILE                                             *
  1439. ' *
  1440. '
  1441. 30500 CLOSE 1
  1442.       IF SHARE.IT THEN _
  1443.          OPEN ACTIVE.MESSAGE.FILE$ ACCESS READ WRITE SHARED AS #1 _
  1444.       ELSE OPEN "R",1,ACTIVE.MESSAGE.FILE$
  1445.       FIELD 1,128 AS MESSAGE.RECORD$
  1446.       END SUB
  1447. ' $SUBTITLE: 'FINDFUNC - subroutine to handle local keyboard functions'
  1448. ' $PAGE
  1449. '
  1450. '  SUBROUTINE NAME    -- FINDFUNC
  1451. '
  1452. '  INPUT PARAMETERS   --
  1453. '               PARAMETER                 MEANING
  1454. '             ACTIVE.MENU$              INDICATOR OF ACTIVE MENU
  1455. '             ADJUSTED.SECURITY         SWITCH INDICATING TEMP. SECURITY CHANGE
  1456. '             AUTODOWNLOAD.DESIRED      USER'S PREFERENCE FOR AUTODOWNLOADING
  1457. '             CALLERS.FILE$             NAME OF CALLERS FILE
  1458. '             CHAT.AVAILABLE            TOGGLE INDICATING IF SYSOP WILL CHAT
  1459. '             CHECK.BULLETIN.LOGON      USER'S PREFERENCE FOR BULLETIN CHECK
  1460. '             CONFERENCE.MODE           INDICATOR THAT USER IS IN A CONFERENCE
  1461. '             CURSOR.LINE               LINE THAT THE CURSOR IS AT
  1462. '             CURSOR.ROW                ROW THAT THE CURSOR IS AT
  1463. '             DISK.FOR.DOS$             DISK TO LOAD COMMAND.COM FROM
  1464. '             DISKFULL.GO.OFFLINE       INDICATOR OF WHAT TO DO WHEN DISK FULL
  1465. '             EXIT.TO.DOORS             FLAG INDICATING EXITING TO DOORS
  1466. '             EXPERT.USER               FLAG FOR EXPERT/NOVICE USER MODE
  1467. '             FIRST.NAME$               LOGGED ON USER'S FIRST NAME
  1468. '             F1.KEY                    FUNCTION KEY ONE VALUE
  1469. '             F10.KEY                   FUNCTION KEY TEN VALUE
  1470. '             GR                        GRAPHICS PREFERENCE OF USER
  1471. '             LINE.FEEDS                SWTICH FOR USER'S LINE FEED PREFERENCE
  1472. '             LOCAL.USER                FLAG INDICATING USER IS LOCAL
  1473. '             MINIMUM.LOGON.SECURITY    MINIMUM SECURITY TO LOGON
  1474. '             MODEM.GO.OFFHOOK.COMMAND$ COMMAND TO TAKE MODEM OFF-HOOK
  1475. '             MODEM.INIT.BAUD$          BAUD TO INITIALIZE MODEM AT
  1476. '             NODE.ID$                  NODE IDENTIFIER
  1477. '             NODE.RECORD.INDEX         NODE RECORD INDEX FOR THIS NODE
  1478. '             NULLS                     SWITCH FOR USER'S PREFERENCE FOR NULLS
  1479. '             PRINTER                   TOGGLE INDICATING PRINTER IS AVAILABLE
  1480. '             PROMPT.BELL               USER'S PREFERENCE FOR BELLS ON PROMPTS
  1481. '             SECONDS.PER.SESSION      TIME LEFT IN CURRENT USER SESSION 'DA011205
  1482. '             SKIP.FILES.LOGON          USER'S LOGON NOTIFICIATION PREFERENCE
  1483. '             SNOOP                     TOGGLE INDICATING SNOOP STATUS
  1484. '             SUBROUTINE.PARAMETER      -8  = SYSOP'S OPTION 6 REMOTELY
  1485. '                                       -9  = GOT TO DOS
  1486. '                                       -10 = SYSOP GET'S SYSTEM NEXT
  1487. '             SYSOP                     INDICATOR THAT USER IS SYSOP
  1488. '             SYSOP.ANNOY               TOGGLE INDICATING SYSOP IS AVAILABLE
  1489. '             SYSOP.NEXT                TOGGLE SO SYSOP GETS SYSTEM NEXT
  1490. '             UPPER.CASE                USER'S PREFERENCE FOR UPPER/LOWER CASE
  1491. '             USER.FILE.INDEX           INDEX INTO THE USER FILE FOR CALLER
  1492. '             USER.SECURITY.LEVEL       USER'S SECURITY LEVEL
  1493. '             USERT.TRANSFER.DEFAULT    USER'S FILE TRANSFER DEFAULT PREFERENCE
  1494. '
  1495. '  OUTPUT PARAMETERS  --
  1496. '             ADJUSTED.SECURITY        SWITCH INDICATING TEMP. SECURITY CHANGE
  1497. '             CHAT.AVAILABLE           TOGGLE INDICATING IF SYSOP WILL CHAT
  1498. '             FUNCTION.KEY             VALUE 1 TO 10 CORRESPONDING TO
  1499. '                                      THE FUNCTION KEY THAT WAS PRESSED
  1500. '             KEY.PRESSED$             CHARACTER STRING GENERATED BY KEY
  1501. '             PRINTER                  TOGGEL INDICATING PRINTER IS AVAILABLE
  1502. '             SNOOP                    TOGGLE INDICATING SNOOP STATUS
  1503. '             SYSOP                    INDICATOR THAT USER IS SYSOP
  1504. '             SYSOP.ANNOY              TOGGLE INDICATING SYSOP IS AVAILABLE
  1505. '             SYSOP.NEXT               TOGGLE SO SYSOP GETS SYSTEM NEXT
  1506. '             SUBROUTINE.PARAMETER     -1 CARRIER LOST
  1507. '                                      -2 CHAT MODE ACTIVATED
  1508. '                                      -3 FORCE CALLER ON-LINE
  1509. '                                      -4 EXIT TO SYSTEM IMMEDIATELY
  1510. '                                      -5 EXIT TO SYSTEM AFTER MULTI-LINK CALL
  1511. '                                      -6 TELL USER ACCESS IS DENIED
  1512. '                                      -7 UPDATE CALLERS FILE AND DENY ACCESS
  1513. '             USER.SECURITY.LEVEL      USER'S SECURITY LEVEL
  1514. '
  1515. '  SUBROUTINE PURPOSE -- TO DETERMINE IF A FUNCTION HAS BEEN PRESSED ON
  1516. '                        THE PC'S KEYBOARD THAT IS RUNNING RBBS-PC.
  1517. '
  1518.       SUB FINDFUNC STATIC
  1519.       LOOKUP = SUBROUTINE.PARAMETER
  1520.       IF SUBROUTINE.PARAMETER < -1 THEN _
  1521.          SUBROUTINE.PARAMETER = 0 : _
  1522.          IF LOOKUP = - 8 THEN _
  1523.             GOTO 33070 _
  1524.          ELSE IF LOOKUP = - 9 THEN _
  1525.                  GOTO 31000 _
  1526.               ELSE IF LOOKUP = - 10 THEN _
  1527.                       GOTO 33090
  1528. '
  1529. ' *
  1530. ' *  TEST FOR FUNCTION KEY PRESSED                                            *
  1531. ' *
  1532. '
  1533. 30600 IF KEYBOARD.STACK$ = "" THEN _
  1534.          KEY.PRESSED$ = INKEY$ _
  1535.       ELSE KEY.PRESSED$ = KEYBOARD.STACK$ : _
  1536.            KEYBOARD.STACK$ = ""
  1537.       FUNCTION.KEY = 0
  1538.       IF LEN(KEY.PRESSED$) <> 2 THEN _
  1539.          GOTO 33970
  1540.       KEY.PRESSED = ASC(RIGHT$(KEY.PRESSED$,1))
  1541.       IF LOCAL.USER.MODE THEN _
  1542.          KEY.PRESSED$ = "" : _
  1543.          GOTO 33970
  1544.       IF KEY.PRESSED => F1.KEY AND _
  1545.          KEY.PRESSED <= F10.KEY THEN _
  1546.              FUNCTION.KEY = KEY.PRESSED - 58 : _
  1547.              GOTO 30610
  1548.       IF KEY.PRESSED = 79 THEN _     'End
  1549.          FUNCTION.KEY = 11
  1550.       IF KEY.PRESSED = 73 THEN _     'PgUp
  1551.          FUNCTION.KEY = 12
  1552.       IF KEY.PRESSED = 72 THEN _     'up arrow
  1553.          FUNCTION.KEY = 13
  1554.       IF KEY.PRESSED = 80 THEN _     'Down arrow
  1555.          FUNCTION.KEY = 14
  1556.       IF KEY.PRESSED = 81 THEN _     'PgDn
  1557.          FUNCTION.KEY = 15
  1558.       IF KEY.PRESSED = 75 THEN _     'left arrow
  1559.          FUNCTION.KEY = 16
  1560.       IF KEY.PRESSED = 77 THEN _     'Right arrow
  1561.          FUNCTION.KEY = 17
  1562.       IF KEY.PRESSED = 141 THEN _    'CTRL-up arrow
  1563.          FUNCTION.KEY = 18
  1564.       IF KEY.PRESSED = 132 THEN _    'CTRL-PgUp (same as CTRL-UP)
  1565.          FUNCTION.KEY = 18
  1566.       IF KEY.PRESSED = 145 THEN _    'CTRL-down arrow
  1567.          FUNCTION.KEY = 19
  1568.       IF KEY.PRESSED = 118 THEN _    'CTRL-PgDn (same as CTRL-DOWN)
  1569.          FUNCTION.KEY = 19
  1570.       IF KEY.PRESSED = 115 THEN _    'CTRL-left arrow
  1571.          FUNCTION.KEY = 20
  1572.       IF KEY.PRESSED = 116 THEN _    'CTRL-right arrow
  1573.          FUNCTION.KEY = 21
  1574. 30610 KEY.PRESSED$ = ""
  1575.       IF FUNCTION.KEY < 1 OR FUNCTION.KEY > 21 THEN _
  1576.          GOTO 33970
  1577.       IF FUNCTION.KEY < 10 AND (FUNCTION.KEY <> 8) THEN _
  1578.          GOTO 30620
  1579.       IF TOGGLE.ONLY THEN _
  1580.          SUBROUTINE.PARAMETER = 1 : _
  1581.          GOTO 33970
  1582. 30620 ON FUNCTION.KEY GOTO  31000, _            '  1 =  F1
  1583.                             32000, _            '  2 =  F2
  1584.                             33000, _            '  3 =  F3
  1585.                             33040, _            '  4 =  F4
  1586.                             33060, _            '  5 =  F5
  1587.                             33070, _            '  6 =  F6
  1588.                             33090, _            '  7 =  F7
  1589.                             33110, _            '  8 =  F8
  1590.                             33130, _            '  9 =  F9
  1591.                             33150, _            ' 10 = F10
  1592.                             31398, _            ' 11 = END KEY
  1593.                             33200, _            ' 12 = PGUP
  1594.                             33170, _            ' 13 = UP ARROW
  1595.                             33180, _            ' 14 = DOWN ARROW
  1596.                             33220, _            ' 15 = PGDN
  1597.                             33240, _            ' 16 = LEFT ARROW
  1598.                             33250, _            ' 17 = RIGHT ARROW
  1599.                             33170, _            ' 18 = CTRL-UP ARROW
  1600.                             33180, _            ' 19 = CTRL-DOWN
  1601.                             33245, _            ' 20 = CTRL-LEFT
  1602.                             33255               ' 21 = CTRL-RIGHT
  1603. '
  1604. ' *
  1605. ' * F1 - COMMAND FROM LOCAL KEYBOARD (IMMEDIATE EXIT TO DOS)                  *
  1606. ' *
  1607. '
  1608. 31000 SUBROUTINE.PARAMETER = -10
  1609.       CALL CARRIER
  1610.       IF SUBROUTINE.PARAMETER = 0 THEN _
  1611.          GOTO 33970
  1612.       CALL BRKFNAME(CALLERS.FILE$,X$,Y$,Z$,TRUE)
  1613.       FILE.NAME$ = X$ + "RBBS" + NODE.FILE.ID$ + "F1.DEF"
  1614.       CLOSE 2
  1615.       OPEN "O",2,FILE.NAME$
  1616.       PRINT #2,MID$(FILE.NAME$,3,7)
  1617.       IF EXIT.TO.DOORS THEN _
  1618.          SUBROUTINE.PARAMETER = -4 : _
  1619.          GOTO 33970
  1620.       CALL OPENCOM(MODEM.INIT.BAUD$,",N,8,1")
  1621.       CALL MODEMPUT (MODEM.GO.OFFHOOK.COMMAND$)
  1622.       CALL DELAYIT (2)
  1623.       SUBROUTINE.PARAMETER = -5
  1624.       GOTO 33970
  1625. '
  1626. ' *
  1627. ' *  END KEY - FORCE CURRENT USER OFF AND LOCK THEM OUT                       *
  1628. ' *
  1629. '
  1630. 31398 IF NOT LOCAL.USER THEN _
  1631.          CALL CARRIER : _
  1632.          IF SUBROUTINE.PARAMETER = -1 THEN _
  1633.             GOTO 33970
  1634.       FUNCTION.KEY = 0
  1635.       IF INSTR("MUF",ACTIVE.MENU$) > 0 THEN _
  1636.          GOTO 31399
  1637.       CURSOR.LINE = CSRLIN
  1638.       CURSOR.ROW = POS(0)
  1639.       LOCATE 25,1
  1640.       D$ = SPACE$(79)
  1641.       GOSUB 33210
  1642.       LOCATE 25,1
  1643.       D$ ="Cannot FORCE OFF until user reaches MAIN menu"
  1644.       GOSUB 33210
  1645.       CALL DELAYIT (1)
  1646.       LOCATE CURSOR.LINE,CURSOR.ROW
  1647.       SUBROUTINE.PARAMETER = 1
  1648.       CALL LINE25
  1649.       GOTO 33970
  1650. 31399 CALL QTPUT(FIRST.NAME$ + ", goodbye and don't call back",1)
  1651.       IF USER.FILE.INDEX < 1 THEN _
  1652.          SUBROUTINE.PARAMETER = -6 : _
  1653.          GOTO 33970
  1654.       USER.SECURITY.LEVEL = MINIMUM.LOGON.SECURITY - 1
  1655.       CALL DENYACCESS
  1656.       SUBROUTINE.PARAMETER = -7
  1657.       GOTO 33970
  1658. '
  1659. ' *
  1660. ' * F2 - COMMAND FROM LOCAL KEYBOARD (SYSOP EXIT TO DOS AND RETURN)           *
  1661. ' *
  1662. '
  1663.  
  1664. 32000 IF NOT LOCAL.USER THEN _
  1665.          CALL SKIPLINE (1) : _
  1666.          CALL QTPUT("Sysop exiting to DOS. Please wait...",1) : _
  1667.          FUNCTION.KEY = 0 : _
  1668.          CALL DELAYIT (3)
  1669.       SHELL DISK.FOR.DOS$ + _
  1670.             "COMMAND"
  1671.       CLS
  1672.       IF NOT LOCAL.USER THEN _
  1673.          CALL CARRIER : _
  1674.          IF SUBROUTINE.PARAMETER = -1 THEN _
  1675.             GOTO 33970
  1676.       SUBROUTINE.PARAMETER = 2
  1677.       CALL LINE25
  1678.       CALL QTPUT ("Sysop back from DOS.  Returning control to you.",1)
  1679.       COMMPORT.STACK$ = CARRIAGE.RETURN$
  1680.       GOTO 33970
  1681. '
  1682. ' *
  1683. ' * F3 - COMMAND FROM LOCAL KEYBOARD (PRINTER TOGGLE)                         *
  1684. ' *
  1685. '
  1686. 33000 PRINTER = NOT PRINTER
  1687.       CHANGE.VALUE = PRINTER
  1688.       FIELD.POSITION = 38
  1689.       GOTO 33950
  1690. '
  1691. ' *
  1692. ' * F4 - COMMAND FROM LOCAL KEYBOARD (SYSOP ANNOY)                            *
  1693. ' *
  1694. '
  1695. 33040 SYSOP.ANNOY = NOT SYSOP.ANNOY
  1696.       CHANGE.VALUE = SYSOP.ANNOY
  1697.       FIELD.POSITION = 34
  1698.       GOTO 33950
  1699. '
  1700. ' *
  1701. ' * F5 - COMMAND FROM LOCAL KEYBOARD (FORCE CALLER ONLINE)                    *
  1702. ' *
  1703. '
  1704. 33060 FUNCTION.KEY = 0
  1705.       SUBROUTINE.PARAMETER = -3
  1706.       GOTO 33970
  1707. '
  1708. ' *
  1709. ' * F6 - COMMAND FROM LOCAL KEYBOARD (SYSOP AVAILABLE TOGGLE)                 *
  1710. ' *  6 - COMMAND FROM SYSOP MENU (SYSOP AVAILABLE TOGGLE)                     *
  1711. ' *
  1712. '
  1713. 33070 SYSOP.AVAILABLE = NOT SYSOP.AVAILABLE
  1714.       CHANGE.VALUE = SYSOP.AVAILABLE
  1715.       FIELD.POSITION = 32
  1716.       GOTO 33950
  1717. '
  1718. ' *
  1719. ' * F7 - COMMAND FROM LOCAL KEYBOARD (SYSOP GETS SYSTEM NEXT)                 *
  1720. ' *
  1721. '
  1722. 33090 IF ERR=61 AND NOT DISKFULL.GO.OFFLINE THEN _
  1723.          GOTO 33970
  1724.       SYSOP.NEXT = NOT SYSOP.NEXT
  1725.       CHANGE.VALUE = SYSOP.NEXT
  1726.       FIELD.POSITION = 36
  1727.       GOTO 33950
  1728. '
  1729. ' *
  1730. ' * F8 - COMMAND FROM LOCAL KEYBOARD (ASSIGN USER TEMPORARY SYSOP SECURITY)   *
  1731. ' *
  1732. '
  1733. 33110 SYSOP = NOT SYSOP
  1734.       CURSOR.LINE = CSRLIN
  1735.       CURSOR.ROW = POS(0)
  1736.       LOCATE 25,1
  1737.       D$ = SPACE$(79)
  1738.       NUM.RETURNS = 0
  1739.       CALL LPRNT (D$,NUM.RETURNS)
  1740.       LOCATE 25,1
  1741.       USER.SECURITY.LEVEL = (1 + SYSOP) * _
  1742.                             USER.SECURITY.SAVE  - _
  1743.                             SYSOP * _
  1744.                             SYSOP.SECURITY.LEVEL
  1745.       D$ = "SYSOP Privileges " + FNOFFON$(SYSOP)
  1746.       CALL LPRNT (D$,NUM.RETURNS)
  1747.       CALL DELAYIT (3)
  1748.       LOCATE CURSOR.LINE,CURSOR.ROW
  1749.       SUBROUTINE.PARAMETER = 1
  1750.       CALL LINE25
  1751.       CALL CALLOPT
  1752.       GOTO 33970
  1753. '
  1754. ' *
  1755. ' * F9 - COMMAND FROM LOCAL KEYBOARD (SNOOP TOGGLE)                           *
  1756. ' *
  1757. '
  1758. 33130 IF NOT SNOOP THEN _
  1759.          SNOOP = TRUE : _
  1760.          LOCATE 24,1,0 : _
  1761.          D$ = "SNOOP ON" : _
  1762.          NUM.RETURNS = 0 : _
  1763.          CALL LPRNT (D$,NUM.RETURNS) : _
  1764.          SUBROUTINE.PARAMETER = 2 : _
  1765.          CALL LINE25 _
  1766.       ELSE LOCATE ,,0 : _
  1767.            SNOOP = FALSE : _
  1768.            CLS
  1769. 33140 CHANGE.VALUE = SNOOP
  1770.       FIELD.POSITION = 58
  1771.       GOTO 33950
  1772. '
  1773. ' *
  1774. ' * F10 - COMMAND FROM LOCAL KEYBOARD (FORCE CHAT WITH USER)                  *
  1775. ' *
  1776. '
  1777. 33150 IF CHAT.AVAILABLE = TRUE THEN _
  1778.          GOTO 33160
  1779.       CURSOR.LINE = CSRLIN
  1780.       CURSOR.ROW = POS(0)
  1781.       LOCATE 25,1
  1782.       D$ = SPACE$(79)
  1783.       NUM.RETURNS = 0
  1784.       CALL LPRNT (D$,NUM.RETURNS)
  1785.       LOCATE 25,1
  1786.       D$ = "CHAT not available now!"
  1787.       CALL LPRNT (D$,NUM.RETURNS)
  1788.       CALL DELAYIT (1)
  1789.       LOCATE CURSOR.LINE,CURSOR.ROW
  1790. 33155 SUBROUTINE.PARAMETER = 1
  1791.       CALL LINE25
  1792.       GOTO 33970
  1793. 33160 CALL UPDTCALR ("Sysop began chat",1)
  1794.       CALL SKIPLINE (1)
  1795.       CALL QTPUT ("Hi " + _
  1796.            FIRST.NAME$ + _
  1797.            ", this is " + _
  1798.            SYSOP.FIRST.NAME$ + _
  1799.            " " + _
  1800.            SYSOP.LAST.NAME$ + _
  1801.            "  Sorry to break in to CHAT but..",1)
  1802.       FUNCTION.KEY = 0
  1803.       SUBROUTINE.PARAMETER = -2
  1804.       GOTO 33970
  1805. '
  1806. ' *
  1807. ' * UP / CTRL-UP: INCREASE THE ON-LINE USER'S SECURITY BY ONE / FIVE          *
  1808. ' *
  1809. '
  1810. 33170 USER.SECURITY.LEVEL = USER.SECURITY.LEVEL + _
  1811.                             1 - 4 * (FUNCTION.KEY = 18)
  1812.       GOTO 33190
  1813. '
  1814. ' *
  1815. ' * DOWN / CTRL-DOWN: DECREASE THE ON-LINE USER'S SECURITY BY ONE / FIVE      *
  1816. ' *
  1817. '
  1818. 33180 USER.SECURITY.LEVEL = USER.SECURITY.LEVEL - _
  1819.                             1 + 4 * (FUNCTION.KEY = 19)
  1820. 33190 ADJUSTED.SECURITY = TRUE
  1821.       USER.SECURITY.SAVE = USER.SECURITY.LEVEL
  1822.       SUBROUTINE.PARAMETER = 2
  1823.       CALL LINE25
  1824.       CALL CALLOPT
  1825.       GOTO 33970
  1826. '
  1827. ' *
  1828. ' * PGUP DISPLAY USER PROFILE                                                 *
  1829. ' *
  1830. '
  1831. 33200 IF NOT LOCAL.USER THEN _
  1832.          CALL CARRIER : _
  1833.          IF SUBROUTINE.PARAMETER = -1 THEN _
  1834.             GOTO 33970
  1835.       CALL PAGEUP
  1836.       D$ = MID$("NoviceExPERT",1 -6 * EXPERT.USER,6)
  1837.       GOSUB 33210
  1838.       D$ = "GRAPHICS: " + _
  1839.            MID$("None AsciiColor",GR * 5 + 1,5)
  1840.       GOSUB 33210
  1841.       FF = INSTR(DFLTXFER$,USER.TRANSFER.DEFAULT$)
  1842.       D$ = "PROTOCOL : " + _
  1843.            MID$(DFLTXFER$,FF)
  1844.       GOSUB 33210
  1845.       D$ = "UPPER CASE " + _
  1846.            MID$("and lowerONLY", 1 - 9 * UPPER.CASE,9)
  1847.       GOSUB 33210
  1848.       D$ = "Line Feeds " + FNOFFON$(LINE.FEEDS)
  1849.       GOSUB 33210
  1850.       D$ = "Nulls " + FNOFFON$(NULLS)
  1851.       GOSUB 33210
  1852.       D$ = "Prompt Bell " + FNOFFON$(PROMPT.BELL)
  1853.       GOSUB 33210
  1854.       D$ = MID$("SKIP CHECK",1 -5 * CHECK.BULLETIN.LOGON,5) + _
  1855.            " old BULLETINS on logon."
  1856.       GOSUB 33210
  1857.       D$ = MID$("CHECKSKIP ",1 -5 * SKIP.FILES.LOGON,5) + _
  1858.            " new files on logon."
  1859.       GOSUB 33210
  1860.       D$ = "Autodownload " + FNOFFON$(AUTODOWNLOAD.DESIRED)
  1861.       GOSUB 33210
  1862.       GOTO 33970
  1863. 33210 NUM.RETURNS = 1
  1864.       CALL LPRNT(D$,NUM.RETURNS)
  1865.       RETURN
  1866. '
  1867. ' *
  1868. ' * PGDN CLEAR DISPLAY OF USER'S PROFILE                                      *
  1869. ' *
  1870. '
  1871. 33220 IF NOT LOCAL.USER THEN _
  1872.          CALL CARRIER : _
  1873.          IF SUBROUTINE.PARAMETER = -1 THEN _
  1874.             GOTO 33970
  1875.       CLS
  1876.       GOTO 33155
  1877. '
  1878. ' *
  1879. ' * LEFT ARROW - DECREASE THE ON-LINE USER'S TIME BY ONE MINUTE               *
  1880. ' *
  1881. '
  1882. 33240 IF SECONDS.PER.SESSION! > 120 THEN _
  1883.          SECONDS.PER.SESSION! = SECONDS.PER.SESSION! - 60
  1884.       GOTO 33970
  1885. '
  1886. ' *
  1887. ' * CTRL-LEFT ARROW - DECREASE THE ON-LINE USER'S TIME BY FIVE MINUTES        *
  1888. ' *
  1889. '
  1890. 33245 IF SECONDS.PER.SESSION! > 360 THEN _
  1891.          SECONDS.PER.SESSION! = SECONDS.PER.SESSION! - 300
  1892.       GOTO 33970
  1893. '
  1894. ' *
  1895. ' * RIGHT ARROW - INCREASE THE ON-LINE USER'S TIME BY ONE MINUTE              *
  1896. ' *
  1897. '
  1898. 33250 IF SECONDS.PER.SESSION! < 86280 THEN _
  1899.          SECONDS.PER.SESSION! = SECONDS.PER.SESSION! + 60
  1900.       TIME.LOCK.SET = 0
  1901.       GOTO 33970
  1902. '
  1903. ' *
  1904. ' * CTRL-RIGHT ARROW - INCREASE THE ON-LINE USER'S TIME BY FIVE MINUTES       *
  1905. ' *
  1906. '
  1907. 33255 IF SECONDS.PER.SESSION! < 86040 THEN _
  1908.          SECONDS.PER.SESSION! = SECONDS.PER.SESSION! + 300
  1909.       TIME.LOCK.SET = 0
  1910.       GOTO 33970
  1911. '
  1912. ' *
  1913. ' * UPDATE NODE RECORD WITH LOCAL FUNCTION KEY ACTIVITY                       *
  1914. ' *
  1915. '
  1916. 33950 IF SNOOP THEN _
  1917.          SUBROUTINE.PARAMETER = 1 : _
  1918.          CALL LINE25
  1919. 33960 IF CONFERENCE.MODE = TRUE THEN _
  1920.          IF LOCAL.USER THEN _
  1921.             GOTO 33970 _
  1922.          ELSE D$ = "Cannot change status during Conference!" : _
  1923.               GOSUB 33210 : _
  1924.               GOTO 33970
  1925.       SUBROUTINE.PARAMETER = 3
  1926.       CALL FILELOCK
  1927.       IF SUBROUTINE.PARAMETER = -1 THEN _
  1928.          GOTO 33970
  1929.       CALL OPENMSG
  1930.       FIELD 1,128 AS MESSAGE.RECORD$
  1931.       GET 1,NODE.RECORD.INDEX
  1932.       MID$(MESSAGE.RECORD$,FIELD.POSITION,2) = STR$(CHANGE.VALUE)
  1933.       CALL SAVEPROF (2)
  1934.       FIELD 1, 128 AS MESSAGE.RECORD$
  1935. 33970 END SUB
  1936. ' $SUBTITLE: 'PAGEUP - Display user profile to SYSOP'
  1937. ' $PAGE
  1938. '
  1939. '  SUBROUTINE NAME    -- PAGEUP
  1940. '
  1941. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  1942. '                         ACTIVE.USER.NAME$         CURRENT USER NAME
  1943. '                         DOWNLOADS                 # OF FILES DOWNLOADED
  1944. '                         EXPIRATION.DATE$          REGISTRATION EXPIRATION
  1945. '                         LAST.DATE.TIME.ON.SAVE$   LAST DATE & TIME ON SYSTEM
  1946. '                         LAST.MESSAGE.READ         LAST MESSAGE READ BY USER
  1947. '                         PASSWORD.SAVE$            USERS PASSWORD
  1948. '                         TIMES.LOGGED.ON           TIMES USER HAS LOGGED ON
  1949. '                         UPLOADS                   # OF FILES UPLOADED
  1950. '                         USER.SECURITY.SAVE        USERS SECURITY LEVEL
  1951. '
  1952. '  OUTPUT PARAMETERS  --  MESSAGE.RECORD$
  1953. '
  1954. 33990 SUB PAGEUP STATIC
  1955.       CALL LPRNT (" ",1)
  1956.       CALL LPRNT ("USER NAME : " + ACTIVE.USER.NAME$,1)
  1957.       CALL LPRNT ("SECURITY  :" + STR$(USER.SECURITY.SAVE),1)
  1958.       CALL LPRNT ("PASSWORD  :" + PASSWORD.SAVE$,1)
  1959.       CALL LPRNT ("READ MSG. :" + STR$(LAST.MESSAGE.READ),1)
  1960.       CALL LPRNT ("TIMES ON  :" + STR$(TIMES.LOGGED.ON),1)
  1961.       CALL LPRNT ("LAST ON   :" + LAST.DATE.TIME.ON.SAVE$,1)
  1962.       CALL LPRNT ("DOWNLOADS :" + STR$(DOWNLOADS),1)
  1963.       CALL LPRNT ("UPLOADS   :" + STR$(UPLOADS),1)
  1964.       IF ENFORCE.UPLOAD.DOWNLOAD.RATIOS THEN _
  1965.          CALL LPRNT ("DL-BYTES  :" + STR$(DLBYTES!),1) : _
  1966.          CALL LPRNT ("UL-BYTES  :" + STR$(ULBYTES!),1)
  1967.       IF RESTRICT.BY.DATE THEN _
  1968.          CALL LPRNT ("EXPIRATION: " + EXPIRATION.DATE$,1)
  1969.       CALL LPRNT ("User's Profile",1)
  1970.       END SUB
  1971. ' $SUBTITLE: 'CHKTREMAIN - Kicks off if no time remaining'
  1972. ' $PAGE
  1973. '
  1974. '  SUBROUTINE NAME    -- CHKTREMAIN
  1975. '
  1976. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  1977. '                         TIME.LEFT!
  1978. '  OUTPUT PARAMETERS  --     PARAMETER                    MEANING
  1979. '                         TIME.LEFT!      TIME IN MINUTES LEFT IN SESSION
  1980. '                         TCA!            TIME USED IN SECONDS
  1981. '                         SUBROUTINE.PARAMETER   -1 if no time left
  1982.       SUB CHKTREMAIN (TIME.LEFT!) STATIC
  1983. 41008 CALL TIMEREMAIN (TIME.LEFT!)
  1984.       IF BYPASS.TIME.CHECK THEN _
  1985.          EXIT SUB
  1986.       IF TIME.LEFT! < 0.1 THEN _
  1987.          SUBROUTINE.PARAMETER = -1
  1988.       END SUB
  1989. ' $SUBTITLE: 'TIMEREMAIN - calculates time remaining in a session'
  1990. ' $PAGE
  1991. '
  1992. '  SUBROUTINE NAME    -- TIMEREMAIN
  1993. '
  1994. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  1995. '                         USER.LOGON.TIME!
  1996. '                         SECONDS.PER.SESSION!
  1997. '                         BYPASS.TIME.CHECK
  1998. '  OUTPUT PARAMETERS  --     PARAMETER                    MEANING
  1999. '                         TIME.REMAINING! TIME IN MINUTES LEFT IN SESSION
  2000. '                         TCA!            TIME USED IN SECONDS
  2001.       SUB TIMEREMAIN (TIME.REMAINING!) STATIC
  2002. 41010 TOA! = FRE("A")
  2003.       IF BYPASS.TIME.CHECK THEN _
  2004.          TIME.REMAINING! = SECONDS.PER.SESSION! /60 : _
  2005.          EXIT SUB
  2006.       CALL FINDTIME (TI!)
  2007.       ROLLOVER = FALSE
  2008.       IF TI! > USER.LOGON.TIME! THEN _
  2009.          TCA! = TI! - USER.LOGON.TIME! : _
  2010.          GOTO 41020
  2011.       ROLLOVER = TRUE
  2012.       TCA! = TI! + 86400! - USER.LOGON.TIME!
  2013. 41020 IF TIME.TO.DROP.TO.DOS! = 0 OR _
  2014.          OLD.DAT$ = DATE$ THEN _
  2015.          GOTO 41030
  2016.       IF NOT ROLLOVER AND _
  2017.          USER.LOGON.TIME! + SECONDS.PER.SESSION! => TIME.TO.DROP.TO.DOS! THEN _
  2018.          SECONDS.PER.SESSION! = (TIME.TO.DROP.TO.DOS! - USER.LOGON.TIME!) : _
  2019.          SHORTENED = TRUE
  2020.       IF ROLLOVER AND _
  2021.          USER.LOGON.TIME! + SECONDS.PER.SESSION! - 86400 => TIME.TO.DROP.TO.DOS! THEN _
  2022.          SECONDS.PER.SESSION! = TIME.TO.DROP.TO.DOS! : _
  2023.          SHORTENED = TRUE
  2024.       IF SHORTENED AND NOT TOLD.SHORT THEN _
  2025.          TOLD.SHORT = TRUE : _
  2026.          A$ = "Time shortened for scheduled event" : _
  2027.          CALL RINGCALLER
  2028. 41030 TIME.REMAINING! = (SECONDS.PER.SESSION!-TCA!) / 60
  2029.       TIME.REMAINING! = -(TIME.REMAINING! > 0.0)*TIME.REMAINING!
  2030.       END SUB
  2031. ' $SUBTITLE: 'DISPLAYTR - Display users time remaining'
  2032. ' $PAGE
  2033. '
  2034. '  SUBROUTINE NAME    -- DISPLAYTR
  2035. '
  2036. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  2037. '                         TIME.REMAINING!
  2038. '
  2039. '  OUTPUT PARAMETERS  --     PARAMETER                    MEANING
  2040. '                         TIME.REMAINING! TIME IN MINUTES LEFT IN SESSION
  2041. '
  2042.       SUB DISPLAYTR (TIME.REMAINING!) STATIC
  2043.       CALL TIMEREMAIN (TIME.REMAINING!)
  2044.       CALL QTPUT (STR$(INT(TIME.REMAINING!)) + " min left",1)
  2045.       END SUB
  2046. ' $SUBTITLE: 'AMORPM - subroutine to give time of day in AM/PM format'
  2047. ' $PAGE
  2048. '
  2049. '  SUBROUTINE NAME    -- AMORPM
  2050. '
  2051. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  2052. '                        SUBROUTINE.PARAMETER = 1  GET CURRENT TIME AND DATE
  2053. '                        SUBROUTINE.PARAMETER = 2  CALCULATE TIME AS AM OR PM
  2054. '
  2055. '  OUTPUT PARAMETERS  -- CURRENT.DATE$           CURRENT DATE (MM-DD-YY)
  2056. '                        TIM$                    CURRENT TIME (I.E. 1:13 PM)
  2057. '                        TIME.LOGGEND.ON$        TIME USER LOGGED ON (HH:MM:SS)
  2058. '
  2059. '  SUBROUTINE PURPOSE -- TO SET THE OUTPUT PARAMETERS AS INDICATED AND
  2060. '                        DESCRIBE THE TIME AS "AM" OR "PM."
  2061. '
  2062.       SUB AMORPM STATIC
  2063.       ON SUBROUTINE.PARAMETER GOTO 41500,41510
  2064. '
  2065. ' *
  2066. ' *  CALCULATE CURRENT TIME FOR AM OR PM                                      *
  2067. ' *
  2068. '
  2069. 41500 TIME.LOGGED.ON$ = TIME$
  2070.       CURRENT.DATE$ = DATE$
  2071.       CURRENT.DATE$ = LEFT$(CURRENT.DATE$ ,6) + _
  2072.                       RIGHT$(CURRENT.DATE$ ,2)
  2073. 41510 TIM$ = TIME$
  2074.       IF VAL(MID$(TIM$,1,2)) = 12 THEN _
  2075.          MID$(TIM$,1,2) = RIGHT$(STR$(VAL(MID$(TIM$,1,2))),2) : _
  2076.          TIM$ = LEFT$(TIM$,5) + _
  2077.                 " PM" : _
  2078.          EXIT SUB
  2079.       IF VAL(MID$(TIM$,1,2)) > 11 THEN _
  2080.          MID$(TIM$,1,2) = RIGHT$(STR$(VAL(MID$(TIM$,1,2))-12),2) : _
  2081.          TIM$ = LEFT$(TIM$,5) + _
  2082.                 " PM" : _
  2083.          EXIT SUB
  2084.       TIM$ = LEFT$(TIM$,5) + _
  2085.              " AM"
  2086.       END SUB
  2087. ' $SUBTITLE: 'CARRIER - subroutine to monitor carrier on comm. port'
  2088. ' $PAGE
  2089. '
  2090. '  SUBROUTINE NAME    -- CARRIER
  2091. '
  2092. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  2093. '                         LOCAL.USER = 0               REMOTE USER
  2094. '                         LOCAL.USER = -1              LOCAL KEYBOARD USER
  2095. '                         MODEM.STATUS.REGISTER        ADDRESS OF THE COMMUNI-
  2096. '                                                      CATIONS PORT'S REGISTER
  2097. '                         SUBROUTINE.PARAMETER = -9    DON'T WRITE TO CALLERS
  2098. '                         SUBROUTINE.PARAMETER = -10   SAME AS -9, BUT DON'T
  2099. '                                                      DELAY
  2100. '
  2101. '  OUTPUT PARAMETERS  --  SUBROUTINE.PARAMETER = 0     CARRIER STILL PRESENT
  2102. '                         SUBROUTINE.PARAMETER = -1    CARRIER NOT PRESENT
  2103. '
  2104. '  SUBROUTINE PURPOSE --  TO TEST IF CARRIER IS PRESENT (I.E. THE USER
  2105. '                         STILL ON LINE).
  2106. '
  2107.       SUB CARRIER STATIC
  2108.       IF SUBROUTINE.PARAMETER = -1 THEN _
  2109.          EXIT SUB
  2110.       SPEEDY = SUBROUTINE.PARAMETER
  2111.       SUBROUTINE.PARAMETER = 0
  2112. '
  2113. ' *
  2114. ' * TEST FOR CARRIER PRESENT (DROP CALLER IF CARRIER NOT PRESENT)             *
  2115. ' *
  2116. '
  2117. 42000 IF LOCAL.USER THEN _
  2118.          EXIT SUB
  2119.       IF FOSSIL THEN _
  2120.          CALL FOSSTATUS(COMPORT%,STATUS%) : _
  2121.          STATUS% = STATUS% AND &H0080 : _
  2122.          IF STATUS% = &H0080 THEN _
  2123.             EXIT SUB _
  2124.          ELSE GOTO 42015
  2125. 42010 IF INP(MODEM.STATUS.REGISTER) > 127 THEN _
  2126.          EXIT SUB
  2127. '
  2128. ' *
  2129. ' * IN CASE USER IS 2400 BAUD, PAUSE A SECOND AND CHECK AGAIN FOR CARRIER     *
  2130. ' * DETECT.  SOME 2400 BAUD MODEMS TAKE A WHILE TO SYNCHRONIZE THE CARRIER,   *
  2131. ' * HENCE A THREE-SECOND PAUSE BEFORE CHECKING AGAIN.                         *
  2132. ' *
  2133. '
  2134. 42015 IF SPEEDY = -10 THEN _
  2135.          GOTO 42020
  2136.       CALL DELAYIT (MODEM.INIT.WAIT.TIME)
  2137.       IF FOSSIL THEN _
  2138.          CALL FOSSTATUS(COMPORT%,STATUS%) : _
  2139.          STATUS% = STATUS% AND &H0080 : _
  2140.          IF STATUS% = &H0080 THEN _
  2141.             EXIT SUB
  2142.       IF INP(MODEM.STATUS.REGISTER) > 127 THEN _
  2143.          EXIT SUB
  2144. 42020 SUBROUTINE.PARAMETER = -1
  2145.       IF SPEEDY < -8 THEN _
  2146.          EXIT SUB
  2147.       IF ALREADY.WRITTEN = -9 THEN _
  2148.          EXIT SUB
  2149.       CALL MODEMPUT (MODEM.GO.OFFHOOK.COMMAND$)
  2150.       CALL DELAYIT (MODEM.COMMAND.DELAY.TIME)
  2151.       MODEM.OFFHOOK = -1
  2152.       ALREADY.WRITTEN = -9
  2153.       CALL UPDTCALR ("Carrier dropped",1)
  2154.       END SUB
  2155. ' $SUBTITLE: 'ASKGRAPH -- subroutine to ask users graphic preference'
  2156. ' $PAGE
  2157. '
  2158. '  SUBROUTINE NAME    -- ASKGRAPH
  2159. '
  2160. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  2161. '                         UGD$                         USER GRAPHIC DEFAULT
  2162. '
  2163. '  OUTPUT PARAMETERS  --
  2164. '
  2165. '  SUBROUTINE PURPOSE --  TO DETERMINE USERS GRAPHICS DEFAULT
  2166. '
  2167.       SUB ASKGRAPH (UGD$) STATIC
  2168.       IF EXPERT.USER THEN _
  2169.          GOTO 43007
  2170. 43006 FILE.NAME$ = HELP$(9)
  2171.       CALL BUFFILE (FILE.NAME$,X)
  2172.       IF SUBROUTINE.PARAMETER = -1 THEN _
  2173.          EXIT SUB
  2174. 43007 CALL QTPUT ("GRAPHICS for text files and menus",1)
  2175.       A$ = "Change from " + MID$("NAC",GR+1,1) + " to N)one, A)scii-IBM, C)olor-IBM, H)elp" + PRESS.ENTER.EXPERT$
  2176.       SUBROUTINE.PARAMETER = 1
  2177.       TURBO.KEY = -TURBO.KEY.USER
  2178.       CALL TGET
  2179.       IF SUBROUTINE.PARAMETER = -1 THEN _
  2180.          EXIT SUB
  2181.       IF Q = 0 THEN _
  2182.          CALL QTPUT ("Unchanged",1) : _
  2183.          EXIT SUB
  2184.       CALL ALLCAPS (B$(1))
  2185.       GR = INSTR("NAC",B$(1))
  2186.       IF GR = 2 AND NOT EIGHT.BIT THEN _
  2187.          CALL QTPUT ("Ascii unavailable.  Requires 8 bit",1) : _
  2188.          GOTO 43007
  2189.       IF GR = 0 THEN _
  2190.          GOTO 43006
  2191.       GR = GR - 1
  2192.       CALL SETUGD (GR,UGD$)
  2193.       END SUB
  2194. '
  2195. ' $SUBTITLE: 'GRAPHIC - subroutine to find graphic version of a file'
  2196. ' $PAGE
  2197. '
  2198. '  SUBROUTINE NAME    -- GRAPHIC
  2199. '
  2200. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  2201. '                            DEFAULT$          USERS GRAPHIC DEFAULT
  2202. '                            GR                WHETHER GRAPHICS ARE AVAILABLE
  2203. '                            FILE.NAME$        FILE TO CHECK
  2204. '
  2205. '  OUTPUT PARAMETERS  --     FILE.NAME$        SUBSTITUTES NAME OF GRAPHICS
  2206. '                                              FILE (IF IT EXISTS).
  2207. '
  2208. '  SUBROUTINE PURPOSE -- CHECKS WHETHER THERE IS A GRAPHICS VERSION OF
  2209. '                        A FILE, BASED ON USERS GRAPHICS PREFERENCE.
  2210. '                        SETS FILE NAME TO GRAPHICS FILE IF IT EXISTS,
  2211. '                        OTHERWISE LEAVES FILE NAME INTACT.  RETURNS FILE
  2212. '                        NAME TO USE.
  2213. '
  2214.       SUB GRAPHIC (DEFAULT$) STATIC
  2215. 43031 OK = FALSE
  2216.       IF GR THEN _
  2217.          CALL BRKFNAME (FILE.NAME$,DR$,X$,EXTENTION$,TRUE) : _
  2218.          IF LEN(X$) < 8 THEN _
  2219.             DF$ = DR$ + _
  2220.                   X$ + _
  2221.                   DEFAULT$ + _
  2222.                   EXTENTION$ : _
  2223.              CALL FINDIT (DF$) : _
  2224.              IF OK THEN _
  2225.                 FILE.NAME$ = DF$ : _
  2226.                 IF DEFAULT$ = "C" THEN _
  2227.                    LINES.PRINTED = 0
  2228.       IF NOT OK THEN _
  2229.          CALL FINDIT (FILE.NAME$)
  2230.       END SUB
  2231. ' $SUBTITLE: 'SAVEPROF - subroutine to read a user profile'
  2232. ' $PAGE
  2233. '
  2234. '  SUBROUTINE NAME    -- SAVEPROF
  2235. '
  2236. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  2237. '                        BPS
  2238. '                        EIGHT.BIT
  2239. '                        EXIT.TO.DOORS
  2240. '                        GR
  2241. '                        KERMIT.FUNCTION
  2242. '                        MESSAGE.RECORD$
  2243. '                        NODE.RECORD.INDEX
  2244. '                        SYSOP
  2245. '                        UPPER.CASE
  2246. '                        TIME.LOGGED.ON$
  2247. '                        PRIVATE.DOOR
  2248. '                        RELIABLE.MODE
  2249. '
  2250. '  OUTPUT PARAMETERS  -- NONE
  2251. '
  2252. '  SUBROUTINE PURPOSE -- SAVES A USER'S OPTIONS AND COMMUNICATIONS PARAMETERS
  2253. '                        IN THE NODE RECORD WHEN A USER EXITS TO A "DOOR" SO
  2254. '                        THAT HE IS IN THE SAME STATUS AS WHEN HE EXITED.
  2255. '
  2256.       SUB SAVEPROF(IPARM) STATIC
  2257.       ON IPARM GOTO 43070,43080
  2258. '
  2259. ' *
  2260. ' *  SAVE USER PROFILE WHEN EXITING                                           *
  2261. ' *
  2262. '
  2263. 43070 ACTIVE.MESSAGE.FILE$ = ORIG.MESSAGE.FILE$
  2264.       SUBROUTINE.PARAMETER = 3
  2265.       CALL FILELOCK
  2266.       CALL OPENMSG
  2267.       FIELD 1, 128 AS MESSAGE.RECORD$
  2268.       GET 1,NODE.RECORD.INDEX
  2269.       IF ACTIVE.USER.NAME$ = "SYSOP" THEN _
  2270.          MID$(MESSAGE.RECORD$,1,30) = SPACE$(30) : _
  2271.          MID$(MESSAGE.RECORD$,1,30) = LEFT$(SYSOP.PASSWORD.1$ + " " + SYSOP.PASSWORD.2$,30)
  2272.       MID$(MESSAGE.RECORD$,40,2) = STR$(EXIT.TO.DOORS)
  2273.       MID$(MESSAGE.RECORD$,42,2) = STR$(EIGHT.BIT)
  2274.       MID$(MESSAGE.RECORD$,44,2) = STR$(BPS)
  2275.       MID$(MESSAGE.RECORD$,46,2) = STR$(UPPER.CASE)
  2276.       MID$(MESSAGE.RECORD$,48,5) = MKS$(NUM.DWN.BYTS!) + MID$(STR$(-BATCH.TRANSFER),2)
  2277.       MID$(MESSAGE.RECORD$,53,2) = STR$(GR)
  2278.       MID$(MESSAGE.RECORD$,55,2) = STR$(SYSOP)
  2279.       MID$(MESSAGE.RECORD$,65,3) = CHR$(VAL(LEFT$(TIME.LOGGED.ON$,2))) + _
  2280.                                    CHR$(VAL(MID$(TIME.LOGGED.ON$,4,2))) + _
  2281.                                    CHR$(VAL(MID$(TIME.LOGGED.ON$,7,2)))
  2282.       MID$(MESSAGE.RECORD$,72,2) = STR$(PRIVATE.DOOR)
  2283.       MID$(MESSAGE.RECORD$,74,1) = MID$(STR$(TRANSFER.FUNCTION),2,1)
  2284.       MID$(MESSAGE.RECORD$,75,1) = FT$
  2285.       MID$(MESSAGE.RECORD$,91,2) = STR$(RELIABLE.MODE)
  2286.       CALL BRKFNAME (CURRENT.PUI$,A$,B$,Z$,FALSE)
  2287.       MID$(MESSAGE.RECORD$,93,8) = B$ + SPACE$(8 - LEN(B$))
  2288.       MID$(MESSAGE.RECORD$,101,2) = STR$(LOCAL.USER)
  2289.       MID$(MESSAGE.RECORD$,103,2) = STR$(LOCAL.USER.MODE)
  2290.       GRN$ = LEFT$(GRN$,INSTR(GRN$ + " "," ") - 1)
  2291.       MID$(MESSAGE.RECORD$,105,8) = GRN$ + SPACE$(8 - LEN(GRN$))
  2292.       MID$(MESSAGE.RECORD$,117,2) = STR$(MENU.INDEX)
  2293.       MID$(MESSAGE.RECORD$,119,2) = LEFT$(DATE$,2)
  2294.       MID$(MESSAGE.RECORD$,121,2) = MID$(DATE$,4,2)
  2295.       MID$(MESSAGE.RECORD$,123,2) = RIGHT$(DATE$,2)
  2296.       MID$(MESSAGE.RECORD$,125,2) = LEFT$(TIME$,2)
  2297.       MID$(MESSAGE.RECORD$,127,2) = MID$(TIME$,4,2)
  2298. 43080 PUT 1,NODE.RECORD.INDEX
  2299.       SUBROUTINE.PARAMETER = 2
  2300.       CALL FILELOCK
  2301.       CALL OPENMSG
  2302.       END SUB
  2303. ' $SUBTITLE: 'READPROF - subroutine to restore a user profile'
  2304. ' $PAGE
  2305. '
  2306. '  SUBROUTINE NAME    -- READPROF
  2307. '
  2308. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  2309. '                        NODE.RECORD.INDEX     NODE RECORD TO USE
  2310. '                        SYSOP.PASSWORD.1$     SYSOP'S PSEUDONYM 1
  2311. '                        SYSOP.PASSWORD.2$     SYSOP'S PSEUDONYM 2
  2312. '
  2313. '  OUTPUT PARAMETERS  -- USER'S OPTIONS AND COMMUNICATIONS PARAMETERS
  2314. '                        UPON EXITING RBBS-PC TO A "DOOR"
  2315. '
  2316. '  SUBROUTINE PURPOSE -- RESET A USER'S OPTIONS AND COMMUNICATIONS PARAMETERS
  2317. '                        THAT WERE SAVED IN THE NODE RECORD WHEN A USER EXITED
  2318. '                        TO A "DOOR" SO THAT HE IS IN THE SAME STATUS AS WHEN
  2319. '                        HE EXITED.
  2320. '
  2321.       SUB READPROF STATIC
  2322. '
  2323. ' *
  2324. ' *  RESTORE USER PROFILE WHEN RETURNING FROM DOORS                           *
  2325. ' *
  2326. '
  2327. 44000 LOCATE 24,1
  2328.       CALL LPRNT("NODE INDEX" + STR$(NODE.RECORD.INDEX),1)
  2329.       FIELD 1, 128 AS MESSAGE.RECORD$
  2330.       GET 1,NODE.RECORD.INDEX
  2331.       RELIABLE.MODE = VAL(MID$(MESSAGE.RECORD$,91,2))
  2332.       MID$(MESSAGE.RECORD$,40,2) = "00"
  2333.       EIGHT.BIT = VAL(MID$(MESSAGE.RECORD$,42,2))
  2334.       BPS = VAL(MID$(MESSAGE.RECORD$,44,2))
  2335.       CALL COMMINFO
  2336.       BAUD.TEST = VAL(MID$("      300  450 1200 2400 4800 960019200",(-5 * BPS),5))
  2337.       UPPER.CASE = VAL(MID$(MESSAGE.RECORD$,46,2))
  2338.       NUM.DWN.BYTS! = CVS(MID$(MESSAGE.RECORD$,48,4))
  2339.       BATCH.TRANSFER = (MID$(MESSAGE.RECORD$,52,1) = "1")
  2340.       GR = VAL(MID$(MESSAGE.RECORD$,53,2))
  2341.       TIME.LOGGED.ON$ = RIGHT$("0"+MID$(STR$(ASC(MID$(MESSAGE.RECORD$,65,1))),2),2) + _
  2342.                         ":" + _
  2343.                         RIGHT$("0"+MID$(STR$(ASC(MID$(MESSAGE.RECORD$,66,1))),2),2) + _
  2344.                         ":" + _
  2345.                         RIGHT$("0"+MID$(STR$(ASC(MID$(MESSAGE.RECORD$,67,1))),2),2)
  2346.       TRANSFER.FUNCTION = VAL(MID$(MESSAGE.RECORD$,74,1))
  2347.       FT$ = MID$(MESSAGE.RECORD$,75,1)
  2348.       MENU.INDEX = VAL(MID$(MESSAGE.RECORD$,117,2))
  2349.       CURRENT.PUI$ = MID$(MESSAGE.RECORD$,93,8)
  2350.       CALL REMOVE (CURRENT.PUI$," ")
  2351.       IF CURRENT.PUI$ <> "" THEN _
  2352.          CALL BRKFNAME (MAIN.PUI$,A$,B$,Z$,TRUE) : _
  2353.          CURRENT.PUI$ = A$ + CURRENT.PUI$ + Z$
  2354.       CUSTOM.PUI = (CURRENT.PUI$ <> "")
  2355.       LOCAL.USER = VAL(MID$(MESSAGE.RECORD$,101,2))
  2356.       LOCAL.USER.MODE = VAL(MID$(MESSAGE.RECORD$,103,2))
  2357.       HOME.CONFERENCE$ = MID$(MESSAGE.RECORD$,105,8)
  2358.       CALL TRIM (HOME.CONFERENCE$)
  2359.       IF REQUIRED.RINGS > 0 AND _
  2360.          INSTR(MODEM.INIT.COMMAND$,"S0=255") THEN _
  2361.          COLOR 7,0,0 _
  2362.       ELSE COLOR FG,BG,BORDER
  2363.       IF LOCAL.USER.MODE THEN _
  2364.          GOTO 44003
  2365.       CALL SETBAUD
  2366. 44003 CALL FINDTIME (USER.LOGON.TIME!)
  2367.       IF MINUTES.PER.SESSION! < 1 THEN _
  2368.          MINUTES.PER.SESSION! = 3
  2369.       IF NOT EIGHT.BIT THEN _
  2370.          OUT LINE.CONTROL.REGISTER,&H1A
  2371.       FIRST.NAME.END = INSTR(MESSAGE.RECORD$," ")
  2372.       LAST.NAME.END = INSTR(FIRST.NAME.END + 1,MESSAGE.RECORD$ + " ","  ")
  2373.       FIRST.NAME$ = LEFT$(MESSAGE.RECORD$,FIRST.NAME.END-1)
  2374.       LAST.NAME$ = MID$(MESSAGE.RECORD$,FIRST.NAME.END + 1,LAST.NAME.END - (FIRST.NAME.END + 1))
  2375.       ACTIVE.USER.NAME$ = MID$(FIRST.NAME$ + " " + LAST.NAME$,1,31)
  2376.       Z$ = FIRST.NAME$
  2377.       END SUB
  2378. ' $SUBTITLE: 'COMMINFO - subroutine for variable of users baud/parity'
  2379. ' $PAGE
  2380. '
  2381. '  SUBROUTINE NAME    -- COMMINFO
  2382. '
  2383. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  2384. '                              BPS               BAUD RATE INDICATOR
  2385. '                            EIGHT.BIT           INDICATE FOR N/8/1
  2386. '
  2387. '  OUTPUT PARAMETERS  -- BAUD.PARITY$
  2388. '
  2389. '  SUBROUTINE PURPOSE -- CREATE A STRING THAT SHOWS A USERS BAUD RATE AND
  2390. '                        PARITY.
  2391. '
  2392.       SUB COMMINFO STATIC
  2393. '
  2394. ' *
  2395. ' *  DETERMINE BAUD AND PARITY                                                *
  2396. ' *
  2397. '
  2398.   IF RELIABLE.MODE THEN _
  2399.      RELIABLE.MODE$ = "-R," _
  2400.   ELSE RELIABLE.MODE$ = ","
  2401.   BAUD.PARITY$ = MID$("      300  450 1200 2400 4800 960019200",(-5 * BPS),5) + _
  2402.                  " BAUD" + _
  2403.                  RELIABLE.MODE$ + _
  2404.                  MID$("N,8,1E,7,1",6 + 5 * EIGHT.BIT,5)
  2405.   BAUD.TEST = VAL(BAUD.PARITY$)
  2406.   END SUB
  2407. ' $SUBTITLE: 'DELAYIT - subroutine to wait number of seconds specified'
  2408. ' $PAGE
  2409. '
  2410. '  SUBROUTINE NAME    -- DELAYIT
  2411. '
  2412. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  2413. '                             DELAY.TIME           NUMBER OF SECONDS TO DELAY
  2414. '                                                  (0 TO 3,600)
  2415. '
  2416. '  OUTPUT PARAMETERS  -- NONE
  2417. '
  2418. '  SUBROUTINE PURPOSE -- TO WAIT THE NUMBER OF SECONDS INDICATED BEFORE
  2419. '                        RETURNING CONTROL TO THE CALLING ROUTINE.
  2420. '
  2421.       SUB DELAYIT (DELAY.TIME) STATIC
  2422.       IF DELAY.TIME < 1 THEN _
  2423.          EXIT SUB
  2424.       CALL FINDTIME (DELAY!)
  2425.       DELAY! = DELAY.TIME + DELAY!
  2426.       IF DELAY! < 86400! THEN _
  2427.          GOTO 50520
  2428. 50500 CALL FINDTIME (TI!)
  2429.       IF TI! > DELAY.TIME THEN _  ' IF SECONDS TO DELAY IS PAST
  2430.          GOTO 50500              ' MIDNIGHT WAIT FOR THE CLOCK TO WRAP AROUND
  2431.       DELAY! = DELAY! - 86400!   ' TO PAST MIDNIGHT AND ADJUST THE DELAY
  2432. 50520 CALL FINDTIME (TI!)
  2433.       IF TI! < DELAY! THEN _
  2434.          GOTO 50520
  2435.       END SUB
  2436. ' $SUBTITLE: 'MODEMPUT - subroutine to write modem commands to modem'
  2437. ' $PAGE
  2438. '
  2439. '  SUBROUTINE NAME    -- MODEMPUT
  2440. '
  2441. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  2442. '                        STRNG$                    MODEM COMMAND
  2443. '                        COMMANDS.BETWEEN.RINGS    INDICATOR TO WAIT FOR
  2444. '                                                  MODEM TO STOP RINGING
  2445. '                                                  BEFORE ISSUING COMMANDS
  2446. '                        DUMB.MODEM                INDICATOR THAT MODEM WOULD
  2447. '                                                  NOT UNDERSTAND COMMANDS
  2448. '
  2449. '  OUTPUT PARAMETERS  -- NONE
  2450. '
  2451. '  SUBROUTINE PURPOSE -- TO ISSUE MODEM COMMANDS TO THE MODEM
  2452. '
  2453.       SUB MODEMPUT (STRNG$) STATIC
  2454. '
  2455. ' *
  2456. ' *  SEND MODEM COMMAND                                                       *
  2457. ' *
  2458. '
  2459. 52070 IF DUMB.MODEM THEN _
  2460.          EXIT SUB
  2461.       IF NOT COMMANDS.BETWEEN.RINGS OR _
  2462.          NOT (INP(MODEM.STATUS.REGISTER) AND &H40) THEN _
  2463.          GOTO 52080
  2464.       CALL SETABORT (CONNECT.DELAY!,7)
  2465. 52072 IF (INP(MODEM.STATUS.REGISTER) AND &H40) > 0 THEN _
  2466.          CALL FINDTIME (TI!) : _
  2467.          IF TI! > CONNECT.DELAY! OR _
  2468.             (ABS(CONNECT.DELAY! - TI!) > 30 AND _
  2469.              (TI! + 86400 > CONNECT.DELAY!)) THEN _
  2470.             GOTO 52080
  2471.       GOTO 52072
  2472. 52080 CALL DELAYIT (MODEM.COMMAND.DELAY.TIME)
  2473.       IF FOSSIL THEN _
  2474.          STRNG$ = STRNG$ + CARRIAGE.RETURN$ : _
  2475.          BYTES% = LEN(STRNG$) : _
  2476.          CALL FOSWRITE(COMPORT%,BYTES%,STRNG$) _
  2477.       ELSE PRINT #3,STRNG$
  2478.       END SUB
  2479. ' $SUBTITLE: 'DISPCALL - subroutine to display callers file'
  2480. ' $PAGE
  2481. '
  2482. '  SUBROUTINE NAME    -- DISPCALL
  2483. '
  2484. '  INPUT PARAMETERS   --     PARAMETER           MEANING
  2485. '
  2486. '  OUTPUT PARAMETERS  --  (NONE)
  2487. '
  2488. '  SUBROUTINE PURPOSE -- DISPLAYS CALLERS FILE TO SYSOPS AND CALLERS
  2489. '
  2490. 57001 SUB DISPCALL STATIC
  2491.       IF CALLERS.FILE$ = "" THEN _
  2492.          EXIT SUB
  2493.       CALL SKIPLINE (1)
  2494.       CALLERS.FILE.INDEX.TEMP! = CALLERS.FILE.INDEX!
  2495.       CLOSE 4
  2496.       IF SHARE.IT THEN _
  2497.          OPEN CALLERS.FILE$ LOCK WRITE AS #4 LEN=64 _
  2498.       ELSE OPEN "R",4,CALLERS.FILE$,64
  2499.       FIELD 4,64 AS CALLERS.RECORD$
  2500. 57005 IF CALLERS.FILE.INDEX.TEMP! < 1 OR RET THEN _
  2501.          EXIT SUB
  2502. 57010 GET 4,CALLERS.FILE.INDEX.TEMP!
  2503.       A$ = CALLERS.RECORD$
  2504.       IF LEFT$(A$,3) = "   " OR _
  2505.          INSTR(A$,"on at") = 0 THEN _
  2506.          GOTO 57030
  2507. 57025 CALLERS.FILE.INDEX.TEMP! = CALLERS.FILE.INDEX.TEMP! - 1
  2508.       GET 4,CALLERS.FILE.INDEX.TEMP!
  2509.       Z = INSTR(CALLERS.RECORD$,"{")
  2510.       IF Z < 1 OR Z > 15 THEN _
  2511.          Z = 15
  2512.       IF SYSOP OR _
  2513.          LEFT$(A$,3) <> "   " THEN _
  2514.          A$ = A$ + LEFT$(CALLERS.RECORD$,Z - 1)
  2515.       GOSUB 57100
  2516.       IF SYSOP THEN _
  2517.          A$ = MID$(CALLERS.RECORD$,Z) : _
  2518.          GOSUB 57100
  2519.       GOTO 57045
  2520. 57030 IF SYSOP THEN _
  2521.          GOSUB 57100
  2522. 57045 CALLERS.FILE.INDEX.TEMP! = CALLERS.FILE.INDEX.TEMP! -1
  2523.       GOTO 57005
  2524. 57100 IF INSTR(A$,"LOGON DENIED") THEN _
  2525.          IF NOT SYSOP THEN _
  2526.             RETURN
  2527.       CALL QTPUT (A$,1)
  2528.       CALL ASKMORE ("",TRUE,TRUE,X,FALSE)
  2529.       IF NO OR SUBROUTINE.PARAMETER = -1 THEN _
  2530.          EXIT SUB
  2531.       RETURN
  2532.       END SUB
  2533. ' $SUBTITLE: 'FINDTIME - subroutine to calculate seconds since midnight'
  2534. ' $PAGE
  2535. '
  2536. '  SUBROUTINE NAME    -- FINDTIME
  2537. '
  2538. '  INPUT PARAMETERS   --     PARAMETER           MEANING
  2539. '                            SECONDS!          VARIABLE TO RETURN RESULTS WITH
  2540. '
  2541. '  OUTPUT PARAMETERS  --     SECONDS!          SECONDS SINCE MIDNIGHT
  2542. '
  2543. '  SUBROUTINE PURPOSE -- TO CALCULATE THE NUMBER OF SECONDS THAT HAVE
  2544. '                        ELASPED SINCE MIDNIGHT
  2545. '
  2546.       SUB FINDTIME (SECONDS!) STATIC
  2547. 58050 SECONDS! = TIMER
  2548.       END SUB
  2549. ' $SUBTITLE: 'ALLCAPS - subroutine to convert string to upper case'
  2550. ' $PAGE
  2551. '
  2552. '  SUBROUTINE NAME    -- ALLCAPS
  2553. '
  2554. '  INPUT PARAMETERS   --     PARAMETER           MEANING
  2555. '                            CONVERT.FIELD$    STRING TO MAKE UPPER CASE
  2556. '
  2557. '  OUTPUT PARAMETERS  --     CONVERT.FIELD$    CONVERTED STRINGS
  2558. '
  2559. '  SUBROUTINE PURPOSE -- SUBROUTINE TO CONVERT A STRING TO UPPER CASE
  2560. '
  2561.       SUB ALLCAPS (CONVERT.FIELD$) STATIC
  2562. 58060 IF TURBO.RBBS THEN _
  2563.          CALL RBBSULC (CONVERT.FIELD$) : _
  2564.          EXIT SUB
  2565.       FOR Z = 1 TO LEN(CONVERT.FIELD$)
  2566.          IF MID$(CONVERT.FIELD$,Z,1) > "@" THEN _
  2567.             MID$(CONVERT.FIELD$,Z,1) = CHR$(ASC(MID$(CONVERT.FIELD$,Z,1)) AND 223)
  2568.       NEXT
  2569.       END SUB
  2570. ' $SUBTITLE: 'CHECKTIM - subroutine to see if time has elasped'
  2571. ' $PAGE
  2572. '
  2573. '  SUBROUTINE NAME    -- CHECKTIM
  2574. '
  2575. '  INPUT PARAMETERS   --     PARAMETER           MEANING
  2576. '                            MAX.TIME!         NUMBER OF SECONDS PAST MIDNIGHT
  2577. '                                              NOT TO EXCEED
  2578. '
  2579. '  OUTPUT PARAMETERS  -- SUBROUTINE.PARAMETER = 1 CURRENT TIME IS LESS THAN
  2580. '                                                 MAX.TIME!
  2581. '                        SUBROUTINE.PARAMETER = 2 CURRENT TIME IS GREATER THAN
  2582. '                                                 OR EQUAL TO MAX.TIME!
  2583. '
  2584. '  SUBROUTINE PURPOSE -- SUBROUTINE TO CHECK IF THE CURRENT TIME IS GREATER
  2585. '                        THAN OR EQUAL TO THE TIME ALLOWED
  2586. '
  2587.       SUB CHECKTIM (MAX.TIME!) STATIC
  2588. 58070 SUBROUTINE.PARAMETER = 1
  2589.       CALL FINDTIME (TI!)
  2590.       IF MAX.TIME! < 86400 AND TI! < MAX.TIME! THEN _
  2591.          EXIT SUB
  2592.       IF MAX.TIME! < 86400 AND TI! => MAX.TIME! THEN _
  2593.          SUBROUTINE.PARAMETER = 2 : _
  2594.          EXIT SUB
  2595.       TEST.TIME! = MAX.TIME! - 86400
  2596.       IF TEST.TIME! - TI! <= 0 THEN _
  2597.          EXIT SUB
  2598.       IF TI! => TEST.TIME! THEN _
  2599.          SUBROUTINE.PARAMETER = 2
  2600.       END SUB
  2601. ' $SUBTITLE: 'HASHRBBS - subroutine to determine where to look for user'
  2602. ' $PAGE
  2603. '
  2604. '  SUBROUTINE NAME    -- HASHRBBS
  2605. '
  2606. '  INPUT PARAMETERS   --     PARAMETER           MEANING
  2607. '                            STRNG.TO.HASH$    USER NAME TO LOCATE
  2608. '                            MAX.POSITION      MAXIMUM # USERS
  2609. '
  2610. '  OUTPUT PARAMETERS  --     PRIME.HASH        WHERE TO LOOK FIRST
  2611. '                            SECOND.HASH       LOOK THIS FAR AHEAD
  2612. '
  2613. '  SUBROUTINE PURPOSE -- WHERE TO LOOK FOR A USER IN USERS FILE
  2614. '                        LOOK FIRST AT PRIME POSITION, THEN ADD
  2615. '                        SECOND.HASH UNTIL FIND OR FIND UNUSED RECORD
  2616. '
  2617.       SUB HASHRBBS (STRNG.TO.HASH$,MAX.POSITION,PRIME.HASH,SECOND.HASH) STATIC
  2618. 58080 SECOND.HASH = (ASC(MID$(STRNG.TO.HASH$,2,1)) * 10  + 7) MOD _
  2619.            MAX.POSITION
  2620.       PRIME.HASH = _
  2621.            ((ASC(STRNG.TO.HASH$) * 100  + _
  2622.              ASC(MID$(STRNG.TO.HASH$,(LEN(STRNG.TO.HASH$) / 2) + .1,1)) * _
  2623.              10  + _
  2624.              ASC(RIGHT$(STRNG.TO.HASH$,1))) _
  2625.              MOD MAX.POSITION) + 1
  2626.       END SUB
  2627. ' $SUBTITLE: 'CALLOPT - subroutine to set prompts based on user security'
  2628. ' $PAGE
  2629. '
  2630. '  SUBROUTINE NAME    -- CALLOPT
  2631. '
  2632. '  INPUT PARAMETERS   --     PARAMETER           MEANING
  2633. '                            BEG.MAIN          POSITION START OF MAIN CMDS
  2634. '                            BEG.FILE          POSITION START OF FILE CMDS
  2635. '                            BEG.UTIL          POSITION START OF UTIL CMDS
  2636. '                            BEG.LIBRARY       POSITION START OF LIBRARY CMDS
  2637. '
  2638. '  OUTPUT PARAMETERS  -- PRESENT.OPTS$         DISPLAY WHAT USER CAN DO (1st)
  2639. '                        CALLERS.OPTS$         DISPLAY WHAT USER CAN DO (2nd)
  2640. '                        MAIN.OPTS$            MAIN OPTS USER CAN DO
  2641. '                        FILE.OPTS$            FILE OPTS USER CAN DO
  2642. '                        UTIL.OPTS$            UTIL OPTS USER CAN DO
  2643. '                        LIBRARY.OPTS$         LIBRARY OPTS USER CAN DO
  2644. '
  2645. '  SUBROUTINE PURPOSE -- SETS COMMAND LINE DISPLAY OF WHAT USER CAN DO BY
  2646. '                        SECTION AND DISPLAY OF WHAT ALL USER CAN DO
  2647. '
  2648.       SUB CALLOPT STATIC
  2649. 58090 FIRST = BEG.MAIN
  2650.       LAST = BEG.FILE - 1
  2651.       CALL SETOPTS (MAIN.OPTS$,INVALID.MAIN.OPTS$,FIRST,LAST)
  2652.       FIRST = BEG.FILE
  2653.       LAST = BEG.UTIL - 1
  2654.       CALL SETOPTS (FILE.OPTS$,INVALID.FILE.OPTS$,FIRST,LAST)
  2655.       FIRST = BEG.UTIL
  2656.       LAST = BEG.LIBRARY - 1
  2657.       CALL SETOPTS (UTIL.OPTS$,INVALID.UTIL.OPTS$,FIRST,LAST)
  2658.       FIRST = BEG.LIBRARY
  2659.       LAST = BEG.LIBRARY + 6
  2660.       CALL SETOPTS (LIBRARY.OPTS$,INVALID.LIBRARY.OPTS$,FIRST,LAST)
  2661.       FIRST = 50
  2662.       LAST = 56
  2663.       CALL SETOPTS (SYS.OPTS$,INVALID.SYS.OPTS$,FIRST,LAST)
  2664.       FIRST = 46
  2665.       LAST = 49
  2666.       CALL SETOPTS (GLOBAL.OPTS$,INVALID.GLOBAL.OPTS$,FIRST,LAST)
  2667.       IF LEN(SYS.OPTS$) > 0 THEN _
  2668.          SYSTEM.OPTS$ = "Sysop: " + _
  2669.                         SYS.OPTS$
  2670.       MAIN.OPTS$ = GLOBAL.OPTS$ + _
  2671.                    MAIN.OPTS$
  2672.       FILE.OPTS$ = GLOBAL.OPTS$ + _
  2673.                    FILE.OPTS$
  2674.       UTIL.OPTS$ = GLOBAL.OPTS$ + _
  2675.                    UTIL.OPTS$
  2676.       LIBRARY.OPTS$ = GLOBAL.OPTS$ + _
  2677.                       LIBRARY.OPTS$
  2678.       CALL SRTSTRNG (SYS.OPTS$)
  2679.       CALL SRTSTRNG (MAIN.OPTS$)
  2680.       MAIN.OPTS$ = MAIN.OPTS$ + _
  2681.                    SYS.OPTS$
  2682.       CALL SRTSTRNG (FILE.OPTS$)
  2683.       CALL SRTSTRNG (UTIL.OPTS$)
  2684.       CALL SRTSTRNG (LIBRARY.OPTS$)
  2685.       CALL INSCOMMA (MAIN.OPTS$)
  2686.       CALL INSCOMMA (FILE.OPTS$)
  2687.       CALL INSCOMMA (UTIL.OPTS$)
  2688.       CALL INSCOMMA (LIBRARY.OPTS$)
  2689.       DIR.PROMPT$ = "What directory(s) (" + _
  2690.          MID$("U)pload,A)ll,L)ist,E)xtended +/-, [Q]uit)",8 * (USER.SECURITY.LEVEL => MIN.SEC.TO.VIEW) + 9)
  2691.       QUIT.PROMPT.EXPERT$ = "QUIT C,S, or to F,[M],U,@"
  2692.       QUIT.PROMPT.NOVICE$ = "QUIT C)onference, S)ession or to section " + _
  2693.                             "F)ile, [M]ain, U)til or @)Library"
  2694.       QUIT.LIST$ = "FMUS@C"
  2695.       IF USER.SECURITY.LEVEL < OPT.SEC(18) THEN _
  2696.          QUIT.PROMPT.EXPERT$ = LEFT$(QUIT.PROMPT.EXPERT$,23) : _
  2697.          QUIT.PROMPT.NOVICE$ = LEFT$(QUIT.PROMPT.NOVICE$,61) : _
  2698.          MID$(QUIT.LIST$,5) = " "
  2699.       IF USER.SECURITY.LEVEL < OPT.SEC(15) THEN _
  2700.          QUIT.PROMPT.EXPERT$ = LEFT$(QUIT.PROMPT.EXPERT$,22) + _
  2701.                                MID$(QUIT.PROMPT.EXPERT$,25) : _
  2702.          QUIT.PROMPT.NOVICE$ = LEFT$(QUIT.PROMPT.NOVICE$,56) + _
  2703.                                MID$(QUIT.PROMPT.NOVICE$,63) : _
  2704.          MID$(QUIT.LIST$,3,1) = " "
  2705.       IF USER.SECURITY.LEVEL < OPT.SEC(6) THEN _
  2706.          QUIT.PROMPT.EXPERT$ = LEFT$(QUIT.PROMPT.EXPERT$,16) + _
  2707.                                MID$(QUIT.PROMPT.EXPERT$,19) : _
  2708.          QUIT.PROMPT.NOVICE$ = LEFT$(QUIT.PROMPT.NOVICE$,41) + _
  2709.                                MID$(QUIT.PROMPT.NOVICE$,49) : _
  2710.          MID$(QUIT.LIST$,1,1) = " "
  2711.       CALL SETSECT
  2712.       'CALL PROTOCOL
  2713.       'CALL XFERTYPE (2,TRUE)
  2714.       END SUB
  2715. ' $SUBTITLE: 'SETOPTS - subroutine to set prompts based on user security'
  2716. ' $PAGE
  2717. '
  2718. '  SUBROUTINE NAME    -- SETOPTS
  2719. '
  2720. '  INPUT PARAMETERS   --     PARAMETER           MEANING
  2721. '                            FIRST             POSITION WHERE START LOOKING
  2722. '                            LAST              POSITION WHERE QUIT LOOKING
  2723. '                            USER.SECURITY.LEVEL SECURITY OF USER
  2724. '
  2725. '  OUTPUT PARAMETERS  -- OPTIONS$              LIST OF COMMANDS USER CAN DO
  2726. '
  2727. '  SUBROUTINE PURPOSE -- STRING TOGETHER WHAT COMMANDS USER CAN DO
  2728. '                        IN A SECTION
  2729. '
  2730.       SUB SETOPTS (OPTIONS$,INVALID.OPTIONS$,FIRST,LAST) STATIC
  2731. 58100 OPTIONS$ = ""
  2732.       INVALID.OPTIONS$ = ""
  2733.       FOR I = FIRST TO LAST
  2734.          IF USER.SECURITY.LEVEL < OPT.SEC(I) THEN _
  2735.             INVALID.OPTIONS$ = INVALID.OPTIONS$ + _
  2736.                                MID$(ALL.OPTS$,I,1) _
  2737.          ELSE IF MID$(ALL.OPTS$,I,1) <> " " THEN _
  2738.                  OPTIONS$ = OPTIONS$ + _
  2739.                             MID$(ALL.OPTS$,I,1)
  2740.       NEXT
  2741.       CALL SRTSTRNG (OPTIONS$)
  2742.       CALL SRTSTRNG (INVALID.OPTIONS$)
  2743.       END SUB
  2744. ' $SUBTITLE: 'CHKNEWBUL - subroutine to check whether got new bulletins'
  2745. ' $PAGE
  2746. '
  2747. '  SUBROUTINE NAME    -- CHKNEWBUL
  2748. '
  2749. '  INPUT PARAMETERS   --     PARAMETER           MEANING
  2750. '                            LAST.ON$          LAST DATE OF LOGON
  2751. '                                                FORMAT MM/DD/YY
  2752. '                            ACTIVE.BULLETINS  # OF BULLETING
  2753. '                            BULLETIN.PREFIX$  FILESPEC FOR BULLETINS
  2754. '
  2755. '  OUTPUT PARAMETERS  --     NUM.NEW.BULLETS   NUMBER OF NEW BULLETINS
  2756. '                            NEW.BULLETS$      LIST OF NEW BULLET #'S
  2757. '                            Q                 WHERE LAST BULLETIN STORED
  2758. '                                                 IN B$()
  2759. '                            B$()              BULLETINS #'S THAT ARE NEW
  2760. '                                                 (2,3,4,...)
  2761. '
  2762. '  SUBROUTINE PURPOSE -- CHECKS HOW MANY BULLETINS HAVE SYSTEM DATE
  2763. '                        AT OR LATER THAN DATE CALLER LAST LOGGED ON
  2764. '
  2765.       SUB CHKNEWBUL (LAST.ON$,NUM.NEW.BULLETS,NEW.BULLETS$) STATIC
  2766. 58110 NUM.NEW.BULLETS = 0
  2767.       NEW.BULLETS$ = ":  "
  2768.       BASE.DATE# = VAL(MID$(LAST.ON$,4,2)) + (100 * VAL(MID$(LAST.ON$,1,2))) + _
  2769.                    (10000# * (1900 + VAL(MID$(LAST.ON$,7,2))))
  2770.       CALL FINDIT (BULLETIN.PREFIX$ + ".FCK")
  2771.       IF OK THEN _
  2772.          WHILE NOT EOF(2) : _
  2773.             LINE INPUT #2,Y$ : _
  2774.             GOSUB 58112 : _
  2775.          WEND _
  2776.       ELSE FOR I = 1 TO ACTIVE.BULLETINS : _
  2777.               Y$ = MID$(STR$(I),2) : _
  2778.               GOSUB 58112 : _
  2779.            NEXT
  2780.       Q = NUM.NEW.BULLETS + 1
  2781.       IF NUM.NEW.BULLETS < 1 THEN _
  2782.          NEW.BULLETS$ = ""
  2783.       EXIT SUB
  2784. 58112 X$ = BULLETIN.PREFIX$ + _
  2785.            Y$ + _
  2786.            CHR$(0)
  2787.       CALL RBBSFIND (X$,IX,YY,MM,DD)
  2788.       IF IX = 0 THEN _
  2789.          FDATE# = DD + (100 * MM) + (10000# * (YY + 1980)) : _
  2790.          IF BASE.DATE# <= FDATE# THEN _
  2791.             NUM.NEW.BULLETS = NUM.NEW.BULLETS + 1 : _
  2792.             B$(NUM.NEW.BULLETS + 1) = Y$ : _
  2793.             NEW.BULLETS$ = NEW.BULLETS$ + _
  2794.             " " + _
  2795.             Y$
  2796.       RETURN
  2797.       END SUB
  2798. ' $SUBTITLE: 'SRTSTRNG - subroutine to sort characters in a string'
  2799. ' $PAGE
  2800. '
  2801. '  SUBROUTINE NAME    -- SRTSTRNG
  2802. '
  2803. '  INPUT PARAMETERS   --     PARAMETER           MEANING
  2804. '                            STRNG$           STRING TO SORT
  2805. '
  2806. '  OUTPUT PARAMETERS  --     STRNG$           SORTED STRING
  2807. '
  2808. '  SUBROUTINE PURPOSE -- SORTS CHARACTERS IN PASSED STRING.
  2809. '
  2810.       SUB SRTSTRNG (STRNG$) STATIC
  2811. 58120 S0 = LEN(STRNG$)
  2812.       S1 = S0
  2813.       X$ = "!"
  2814. 58122 S1 = S1\2
  2815.       IF S1 = 0 THEN _
  2816.          EXIT SUB
  2817.       S2 = S0 - S1
  2818.       FOR S3 = 1 TO S2
  2819.          S4 = S3
  2820. 58124    S5 = S4 + S1
  2821.          IF MID$(STRNG$,S4,1) > MID$(STRNG$,S5,1) THEN _
  2822.             LSET X$ = MID$(STRNG$,S4,1) : _
  2823.             MID$(STRNG$,S4,1) = MID$(STRNG$,S5,1) : _
  2824.             MID$(STRNG$,S5,1) = X$ : _
  2825.             S4 = S4 - S1 : _
  2826.             IF S4 > 0 THEN _
  2827.                GOTO 58124
  2828.       NEXT
  2829.       GOTO 58122
  2830.       END SUB
  2831. ' $SUBTITLE: 'INSCOMMA - subroutine to format commands in command prompt'
  2832. ' $PAGE
  2833. '
  2834. '  SUBROUTINE NAME    -- INSCOMMA
  2835. '
  2836. '  INPUT PARAMETERS   --     PARAMETER           MEANING
  2837. '                            STRNG$           STRING TO REPLACE
  2838. '
  2839. '  OUTPUT PARAMETERS  --     STRNG$           REPLACED STRING
  2840. '
  2841. '  SUBROUTINE PURPOSE -- INSERTS COMMANDS BETWEEN EACH LETTER IN STRNG$
  2842. '                        AND ENCLOSES IN POINTED BRACKETS
  2843. '
  2844.       SUB INSCOMMA (STRNG$) STATIC
  2845. 58130 L = LEN(STRNG$)
  2846.       IF L < 1 THEN _
  2847.          EXIT SUB
  2848.       LSET LINEMES$ = " <" + _
  2849.                       LEFT$(STRNG$,1)
  2850.       FOR K = 2 TO L
  2851.          MID$(LINEMES$,2 * K,2) = "," + _
  2852.                                   MID$(STRNG$,K,1)
  2853.       NEXT
  2854.       STRNG$ = LEFT$(LINEMES$,2 * L + 1) + _
  2855.                ">"
  2856.       END SUB
  2857. ' $SUBTITLE: 'LOADNEW - subroutine to get latest uploads'
  2858. ' $PAGE
  2859. '
  2860. '  SUBROUTINE NAME    -- LOADNEW
  2861. '
  2862. '  INPUT PARAMETERS   --     PARAMETER           MEANING
  2863. '                          UPLOAD.DIRECTORY$  LIST OF FILES UPLOADED
  2864. '
  2865. '  OUTPUT PARAMETERS  --     A$               LATEST UPLOADS
  2866. '
  2867. '  SUBROUTINE PURPOSE -- LOADS TABLE OF MOST RECENT NUMBER OF UPLOADS
  2868. '                        BY DATE
  2869. '
  2870.       SUB LOADNEW (ARA(2)) STATIC
  2871. 58140 IF FMS.DIRECTORY$ = "" THEN _
  2872.          EXIT SUB
  2873.       IF PREV.LOADNEW$ = FMS.DIRECTORY$ THEN _
  2874.          ARA(1,1) = 0 : _
  2875.          EXIT SUB
  2876.       PREV.LOADNEW$ = FMS.DIRECTORY$
  2877.       CALL OPENFMS (LAST.REC)
  2878.       FIELD 2, 23 AS PRE.DATE$, _
  2879.                 2 AS MM$, _
  2880.                 1 AS FILL1$, _
  2881.                 2 AS DD$, _
  2882.                 1 AS FILL2$, _
  2883.                 2 AS YY$, _
  2884.                 (2 + MAX.DESC.LEN) AS FILL3$, _
  2885.                 3 AS CATEGORY$, _
  2886.                 2 AS FILL4$
  2887.       MAX.RECS = UBOUND(ARA,1)
  2888.       IF MAX.RECS < 1 THEN _
  2889.          MAX.RECS = 1 _
  2890.       ELSE IF MAX.RECS > 23 THEN _
  2891.               MAX.RECS = 23
  2892.       L = 0
  2893.       K = LAST.REC
  2894.       WHILE K > 0 AND L < MAX.RECS
  2895.          GET #2,K
  2896.          IF INSTR("\= ",LEFT$(PRE.DATE$,1)) > 0 THEN _
  2897.             GOTO 58142
  2898.          IF (CAN.DOWNLOAD.FROM.UP OR CATEGORY$ <> DEFAULT.CATEGORY.CODE$) THEN _
  2899.             L = L + 1 : _
  2900.             ARA(L,1) = 366 * (VAL(YY$) - 80) + 31 * VAL(MM$) + VAL(DD$)
  2901.          IF NOT CAN.DOWNLOAD.FROM.UP THEN _
  2902.             X = MIN.SEC.TO.VIEW _
  2903.          ELSE IF CATEGORY$ = "***" THEN _
  2904.                  X = SYSOP.SECURITY.LEVEL _
  2905.               ELSE IF CATEGORY$ = DEFAULT.CATEGORY.CODE$ THEN _
  2906.                       X = MIN.SEC.TO.VIEW _
  2907.                    ELSE X = OPT.SEC(19)
  2908.          ARA(L,2) = X
  2909. 58142    K = K - 1
  2910.       WEND
  2911.       CLOSE 2
  2912.       END SUB
  2913. ' $SUBTITLE: 'CTNEWFILES - subroutine to count how many files new'
  2914. ' $PAGE
  2915. '
  2916. '  SUBROUTINE NAME    -- CTNEWFILES
  2917. '
  2918. '  INPUT PARAMETERS   --     PARAMETER           MEANING
  2919. '                             LAST.ON$          Date of last logon
  2920. '                             UPLDS$            Latest uploads
  2921. '
  2922. '  OUTPUT PARAMETERS  --    NUM.NEW.FILES       How many after last logon
  2923. '                           RPT.PREFIX$         Set to "At least " if
  2924. '                                                 above is a minimum
  2925. '
  2926. '  SUBROUTINE PURPOSE -- CHECKS HOW MANY FILES IN UPLDS$ WERE UPLOADED ON OR
  2927. '                        AFTER DATE OF LAST LOGON THAT THE USER CAN DOWNLOAD
  2928. '
  2929.       SUB CTNEWFILES (LAST.ON$,UPLDS(2),NUM.USER.FILES,RPT.PREFIX$) STATIC
  2930. 58150 BASE.DATE = 366 * (VAL(MID$(LAST.ON$,7,2)) - 80) + _
  2931.                   31 * (VAL(MID$(LAST.ON$,1,2))) + _
  2932.                   VAL(MID$(LAST.ON$,4,2))
  2933.       NUM.NEW.FILES = 1
  2934.       NUM.USER.FILES = 0
  2935.       WHILE (BASE.DATE <= UPLDS(NUM.NEW.FILES,1) AND _
  2936.                 UPLDS(NUM.NEW.FILES,1) > 0 AND _
  2937.                 NUM.NEW.FILES < UBOUND(UPLDS,1))
  2938.          IF USER.SECURITY.LEVEL => UPLDS(NUM.NEW.FILES,2) THEN _
  2939.             NUM.USER.FILES = NUM.USER.FILES + 1
  2940.          NUM.NEW.FILES = NUM.NEW.FILES + 1
  2941.       WEND
  2942.       IF UPLDS(NUM.NEW.FILES,1) < 1 THEN _
  2943.          NUM.NEW.FILES = NUM.NEW.FILES - 1
  2944.       IF BASE.DATE <= UPLDS(NUM.NEW.FILES,1) THEN _
  2945.          RPT.PREFIX$ = "At least " _
  2946.       ELSE RPT.PREFIX$ = ""
  2947.       END SUB
  2948. ' $SUBTITLE: 'CTLINES - subroutine to determine file categories '
  2949. ' $PAGE
  2950. '
  2951. '  SUBROUTINE NAME    -- CTLINES
  2952. '
  2953. '  INPUT PARAMETERS   -- PARAMETER             MEANING
  2954. '                        DIR.CATEGORY.FILE$    NAME OF THE FILE THAT HAS THE
  2955. '                                              NUMBER OF CATEGORIES IN IT.
  2956. '
  2957. '  OUTPUT PARAMETERS  -- MAX.ENTRIES           NUMBER OF FILE CATEGORIES
  2958. '
  2959. '  SUBROUTINE PURPOSE -- SUBROUTINE TO COUNT THE NUMBER OF CATEGORIES THAT A
  2960. '                        FILE CAN BE CLASSIFIED INTO.
  2961. '
  2962.       SUB CTLINES (MAX.ENTRIES) STATIC
  2963. 58160 MAX.ENTRIES = 3
  2964.       CALL FINDIT (DIR.CATEGORY.FILE$)
  2965.       IF OK THEN _
  2966.          WHILE NOT EOF(2) : _
  2967.             MAX.ENTRIES = MAX.ENTRIES + 1 : _
  2968.             LINE INPUT #2,A$ : _
  2969.          WEND
  2970.       CLOSE 2
  2971.       IF MAX.ENTRIES < 10 THEN _
  2972.          MAX.ENTRIES = 10
  2973.       END SUB
  2974. ' $SUBTITLE: 'INITFMS - subroutine to initialize file management system'
  2975. ' $PAGE
  2976. '
  2977. '  SUBROUTINE NAME    -- INITFMS
  2978. '
  2979. '  INPUT PARAMETERS   -- PARAMETER             MEANING
  2980. '                        FMS.DIRECTORY$
  2981. '
  2982. '  OUTPUT PARAMETERS  -- CATEGORY.NAME$()  ELEMENTS 1,2, POSSIBLY MORE
  2983. '                        CATEGORY.CODE$()  ELEMENTS 1,2, POSSIBLY MORE
  2984. '                        CATEGORY.DESC$()  ELEMENTS 1,2, POSSIBLY MORE
  2985. '                        CATEGORY.INDEX    COUNT OF # ELEMENTS IN THE FILE
  2986. '                                          MANAGMENT SYSTEM
  2987. '
  2988. '  SUBROUTINE PURPOSE -- SUBROUTINE TO INITIALIZE THE RBBS-PC UPLOAD MANAGEMENT
  2989. '                        SYSTEM
  2990.       SUB INITFMS (CATEGORY.NAME$(1),CATEGORY.CODE$(1), _
  2991.                    CATEGORY.DESC$(1),CATEGORY.INDEX) STATIC
  2992.       BLNK$ = " "
  2993.       CATEGORY.INDEX = 0
  2994.       IF FMS.DIRECTORY$ <> "" THEN _
  2995.          CATEGORY.INDEX = CATEGORY.INDEX + 1 : _
  2996.          CATN$ = CATEGORY.NAME$(CATEGORY.INDEX) : _
  2997.          CALL BRKFNAME (FMS.DIRECTORY$,DRVPATH$,CATN$,EXTENSION$,FALSE) : _
  2998.          CATEGORY.NAME$(CATEGORY.INDEX) = CATN$ : _
  2999.          CATEGORY.CODE$(CATEGORY.INDEX) = "" : _
  3000.          CATEGORY.DESC$(CATEGORY.INDEX) = "All uploads"_
  3001.       ELSE LIMIT.SEARCH.TO.FMS = FALSE : _
  3002.            EXIT SUB
  3003.       IF LIMIT.SEARCH.TO.FMS OR MASTER.DIRECTORY.NAME$ = MAIN.FMS.DIRECTORY$ THEN _
  3004.          CATEGORY.INDEX = CATEGORY.INDEX + 1 : _
  3005.          CATEGORY.NAME$(CATEGORY.INDEX) = "ALL" : _
  3006.          CATEGORY.CODE$(CATEGORY.INDEX) = "" : _
  3007.          CATEGORY.DESC$(CATEGORY.INDEX) = "All files"
  3008.       CALL FINDIT (DIR.CATEGORY.FILE$)
  3009.       IF NOT OK THEN _
  3010.          EXIT SUB
  3011.       WHILE NOT EOF(2)
  3012.          CATEGORY.INDEX = CATEGORY.INDEX + 1
  3013.          INPUT #2, CATEGORY.NAME$(CATEGORY.INDEX), _
  3014.                    CATEGORY.CODE$(CATEGORY.INDEX), _
  3015.                    CATEGORY.DESC$(CATEGORY.INDEX)
  3016.          CATR$ = CATEGORY.CODE$(CATEGORY.INDEX)
  3017.          CALL REMOVE (CATR$,BLNK$)
  3018.          CATEGORY.CODE$(CATEGORY.INDEX) = CATR$
  3019.       WEND
  3020.       CLOSE 2
  3021.       END SUB
  3022. ' $SUBTITLE: 'DISUPDIR - subroutine to display upload direcotry'
  3023. ' $PAGE
  3024. '
  3025. '  SUBROUTINE NAME    -- DISUPDIR
  3026. '
  3027. '  INPUT PARAMETERS   -- PARAMETER             MEANING
  3028. '                     PASSED.CATEGORIES$    FILE "CATEGORIES" TO BE INCLUDED IN
  3029. '                                           THE SEARCH.
  3030. '                        SEARCH.STRING$     STRING TO SEARCH ON WITHIN THE
  3031. '                                           FILE "CATEGORIES" SELECTED
  3032. '                        SEARCH.DATE$       DATE EQUAL TO OR GREATER THAN TO BE
  3033. '                                           SEARCHED FOR WITH THE "CATEGORIES"
  3034. '                                           AND THE STRING TO SEARCH.
  3035. '                        DOWNLOAD.FLAG      SET TO RECORD # OF LINE TO BEGIN
  3036. '                                           VIEWING - 0 IF AT END
  3037. '
  3038. '  OUTPUT PARAMETERS  -- DOWNLOAD.FLAG      WHENEVER DOWNLOAD REQUESTED, SETS
  3039. '                                           TO NEXT RECORD TO VIEW.  OTHERWISE
  3040. '                                           LEAVES AT ZERO''  SUBROUTINE PURPOS -- DISPLAY THE FILES THAT MEET THE CRITERIA SELECTED IN
  3041. '                        RBBS-PC UPLOAD MANAGEMENT SYSTEM ON THE USERS SCREEN.
  3042. '
  3043.       SUB DISUPDIR (PASSED.CATEGORIES$,SEARCH.STRING$, _
  3044.                     SEARCH.DATE$,DOWNLOAD.FLAG,ABORT.INDEX) STATIC
  3045. 58165 CALL ALLCAPS (SEARCH.STRING$)
  3046.       BLNK$ = " "
  3047.       STOP.INTERRUPTS = FALSE
  3048.       CATEGORIES$ = "," + _
  3049.                     PASSED.CATEGORIES$ + _
  3050.                     ","
  3051.       CAN.DOWNLOAD = (USER.SECURITY.LEVEL => OPT.SEC(19))
  3052.       GOSUB 58185
  3053.       IF DOWNLOAD.FLAG > 0 THEN _
  3054.          UPLOAD.INDEX = DOWNLOAD.FLAG : _
  3055.          DOWNLOAD.FLAG = 0 : _
  3056.          GOTO 58180
  3057.       EXTRA.PRMPT$ = ",V)iew"
  3058.       IF CAN.DOWNLOAD THEN _
  3059.          IF TURBO.KEY.USER THEN _
  3060.             EXTRA.PRMPT$ = EXTRA.PRMPT$ + ",D)ownload" _
  3061.          ELSE EXTRA.PRMPT$ = EXTRA.PRMPT$ + ", or file(s) to download"
  3062.       MAX.PRINT = PAGE.LENGTH - 1
  3063.       BELOW.MIN.SEC = (USER.SECURITY.LEVEL < MIN.SEC.TO.VIEW)
  3064.       NON.STOP = NON.STOP OR (PAGE.LENGTH < 1)
  3065.       CHECK.POINT = 0
  3066.       WILD.SEARCH = (INSTR(SEARCH.STRING$,"?") > 0) _
  3067.                      OR (INSTR(SEARCH.STRING$,"*") > 0)
  3068. 58168 UPLOAD.INDEX = UPLOAD.INDEX + UPINC
  3069.       IF UPLOAD.INDEX = CUTOFF.REC THEN _
  3070.          GOTO 58183
  3071.       GET #2,UPLOAD.INDEX
  3072.       CHECK.POINT = CHECK.POINT + 1
  3073.       ON INSTR("\* =",LEFT$(PART.TO.PRINT$,1)) GOTO 58168,58171,58170,58169
  3074.       GOTO 58172
  3075. 58169 A = VAL(MID$(PART.TO.PRINT$,34))
  3076.       IF USER.SECURITY.LEVEL < A THEN _
  3077.          LAST.OK = FALSE : _
  3078.          GOTO 58168
  3079.       MID$(PART.TO.PRINT$,1,13) = MID$(PART.TO.PRINT$,2,12) + " "
  3080.       A = LEN(STR$(A))
  3081.       MID$(PART.TO.PRINT$,34) = MID$(PART.TO.PRINT$,34 + A) + SPACE$(A)
  3082.       GOTO 58172
  3083. 58170 IF EXTENDED.OFF THEN _
  3084.          GOTO 58168 _
  3085.       ELSE IF LAST.OK THEN _
  3086.          GOTO 58175 _
  3087.       ELSE IF SEARCH.STRING$ <> "" AND (NOT WILD.SEARCH) AND FAILED.SEARCH THEN _
  3088.               A$ = PART.TO.PRINT$ : _
  3089.               CALL ALLCAPS (A$) : _
  3090.               HIGHLITE.POS = INSTR(A$,SEARCH.STRING$) : _
  3091.               IF HIGHLITE.POS > 0 THEN _
  3092.                  HIGHLITE.REC = UPLOAD.INDEX : _
  3093.                  UPLOAD.INDEX = LAST.FNAME : _
  3094.                  GET 2,UPLOAD.INDEX :_ _
  3095.                  GOTO 58175 _
  3096.               ELSE GOTO 58168 _
  3097.            ELSE GOTO 58168
  3098. 58171 IF CATEGORY$ = "***" THEN _
  3099.          GOTO 58176 _
  3100.       ELSE KEE$ = "," + CATEGORY$ + "," : _
  3101.            IF INSTR(CATEGORIES$,KEE$) > 0 THEN _
  3102.               GOTO 58176 _
  3103.            ELSE GOTO 58168
  3104. 58172 LAST.OK = FALSE
  3105.       FAILED.SEARCH = FALSE
  3106.       LAST.FNAME = UPLOAD.INDEX
  3107.       IF CATEGORY$ = "***" THEN _
  3108.          IF NOT SYSOP THEN _
  3109.             GOTO 58178
  3110.       IF CATEGORY$ = DEFAULT.CATEGORY.CODE$ THEN _
  3111.          IF BELOW.MIN.SEC THEN _
  3112.             GOTO 58178
  3113. 58173 IF LEN(CATEGORIES$) > 2 THEN _
  3114.          KEE$ = "," + _
  3115.                 CATEGORY$ + _
  3116.                 "," : _
  3117.          CALL REMOVE (KEE$,BLNK$) : _
  3118.          IF INSTR(CATEGORIES$,KEE$) = 0 THEN _
  3119.             GOTO 58178
  3120.       IF SEARCH.STRING$ <> "" THEN _
  3121.          A$ = PART.TO.PRINT$ : _
  3122.          IF WILD.SEARCH THEN _
  3123.             CALL WILDFILE (SEARCH.STRING$,LEFT$(PART.TO.PRINT$,INSTR(PART.TO.PRINT$," ")-1),OK) : _
  3124.             IF OK THEN _
  3125.                GOTO 58175 _
  3126.             ELSE GOTO 58178 _
  3127.          ELSE CALL ALLCAPS (A$) : _
  3128.               HIGHLITE.POS = INSTR(A$,SEARCH.STRING$) : _
  3129.               IF HIGHLITE.POS > 0 THEN _
  3130.                  HIGHLITE.REC = UPLOAD.INDEX _
  3131.               ELSE FAILED.SEARCH = TRUE : _
  3132.                    GOTO 58178
  3133. 58174 IF SEARCH.DATE$ <> "" THEN _
  3134.          KEE$ = MID$(PART.TO.PRINT$,30,2) + _
  3135.                 MID$(PART.TO.PRINT$,24,2) + _
  3136.                 MID$(PART.TO.PRINT$,27,2) : _
  3137.          IF KEE$ < SEARCH.DATE$ THEN _
  3138.             IF DATE.ORDERED.FMS THEN _
  3139.                GOTO 58183 _
  3140.             ELSE GOTO 58168
  3141. '
  3142. ' *
  3143. ' * Allow the FMS to be both fast and interruptable if a local                *
  3144. ' * user or there is nothing in the input buffer by using QTPUT.              *
  3145. ' *
  3146. '
  3147. 58175 LAST.OK = TRUE
  3148. 58176 A = END.DESC
  3149.       IF LEFT$(PART.TO.PRINT$,5) = "     " THEN _
  3150.          GOTO 58178
  3151.       WHILE MID$(PART.TO.PRINT$,A,1) = " "
  3152.          A = A - 1
  3153.       WEND
  3154.       A$ = LEFT$(PART.TO.PRINT$,A)
  3155.       CALL COLORDIR (A$,"Y")
  3156.       IF UPLOAD.INDEX = HIGHLITE.REC THEN _
  3157.          HIGHLITE.REC = -1 : _
  3158.          HIGHLITE.POS = 0 : _
  3159.          CALL CHKCOLOR (A$,SEARCH.STRING$,"")
  3160. 58177 IF LOCAL.USER THEN _
  3161.          CALL QTPUT(A$,1) : _
  3162.          GOTO 58178
  3163.       CALL EOFCOMM (CHAR%)
  3164.       IF CHAR% = -1 THEN _
  3165.          CALL QTPUT(A$,1) _
  3166.       ELSE SUBROUTINE.PARAMETER = 5 : _
  3167.            CALL TPUT : _
  3168.            IF RET THEN _
  3169.               GOTO 58183
  3170. 58178 IF LINES.PRINTED <= MAX.PRINT AND CHECK.POINT < 1000 THEN _
  3171.          GOTO 58168
  3172.       CALL CARRIER
  3173.       IF SUBROUTINE.PARAMETER = -1 THEN _
  3174.          GOTO 58183
  3175.       CALL TIMEREMAIN (TIME.REMAINING!)
  3176.       IF TIME.REMAINING! < 0.1 THEN _
  3177.          SUBROUTINE.PARAMETER = -1 : _
  3178.          GOTO 58183
  3179.       IF NON.STOP THEN _
  3180.          GOTO 58168
  3181.       IF LINES.PRINTED <= MAX.PRINT THEN _
  3182.          CALL QTPUT (EMPHASIZE.OFF$ + "Files checked thru " + MID$(PART.TO.PRINT$,24,8),1)
  3183. 58180 TURBO.KEY = -TURBO.KEY.USER
  3184.       CALL ASKMORE (EXTRA.PRMPT$, TRUE, FALSE,ABORT.INDEX,FALSE)
  3185.       IF SUBROUTINE.PARAMETER = -1 THEN _
  3186.          GOTO 58183
  3187.       IF NO THEN _
  3188.          GOTO 58183
  3189.       CALL ALLCAPS (B$(1))
  3190.       IF B$(1) = "V" THEN _
  3191.          CALL GETARC : _
  3192.          A = UPLOAD.INDEX : _
  3193.          GOSUB 58185 : _
  3194.          UPLOAD.INDEX = A : _
  3195.          GOTO 58180
  3196.       IF B$(1) = "D" THEN _
  3197.          A$ = "Download what file(s)" : _
  3198.          SUBROUTINE.PARAMETER = 1 : _
  3199.          CALL TGET : _
  3200.          IF Q = 0 THEN _
  3201.             GOTO 58180
  3202.       IF LEN(B$(1)) > 2 THEN _
  3203.          IF NOT YES AND CAN.DOWNLOAD THEN _
  3204.             CALL SKIPLINE (1) : _
  3205.             DOWNLOAD.FLAG = UPLOAD.INDEX : _
  3206.             EXIT SUB          
  3207.       IF NON.STOP THEN IF UPLOAD.INDEX > 999 THEN _
  3208.          IF (SEARCH.DATE$ = "" OR NOT EXPERT.USER) THEN _
  3209.             A$ = STR$(UPLOAD.INDEX) + _
  3210.                " files left to search.  Really go non-stop? (Y/[N])" : _
  3211.             NO.ADVANCE = TRUE : _
  3212.             TURBO.KEY = -TURBO.KEY.USER : _
  3213.             SUBROUTINE.PARAMETER = 1 : _
  3214.             CALL TGET : _
  3215.             CALL WIPELINE (79) : _
  3216.             IF NOT YES THEN _
  3217.                NON.STOP = FALSE
  3218.       CHECK.POINT = 0
  3219.       GOTO 58168
  3220. 58183 CLOSE 2
  3221.       NON.STOP = (PAGE.LENGTH < 1)
  3222.       STOP.INTERRUPTS = FALSE
  3223.       A$ = ""
  3224.       EXIT SUB
  3225. 58185 CALL OPENFMS (UPLOAD.INDEX)
  3226.       END.DESC = 33 + MAX.DESC.LEN
  3227.       FIELD 2, END.DESC AS PART.TO.PRINT$, _
  3228.                3 AS CATEGORY$, _
  3229.                2 AS FILLER$
  3230.       PREV.FMS$ = ACTIVE.FMS.DIRECTORY$
  3231.       IF UPINC = -1 THEN _
  3232.          CUTOFF.REC = 0 : _
  3233.          UPLOAD.INDEX = UPLOAD.INDEX + 1 _
  3234.       ELSE CUTOFF.REC = UPLOAD.INDEX + 1 : _
  3235.            UPLOAD.INDEX = 0
  3236.       RETURN
  3237.       END SUB
  3238.